Session Gromov_Hyperbolicity

Theory Library_Complements

(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
    License: BSD
*)

section ‹Additions to the library›

theory Library_Complements
  imports "HOL-Analysis.Analysis" "HOL-Cardinals.Cardinal_Order_Relation"
begin

subsection ‹Mono intros›

text ‹We have a lot of (large) inequalities to prove. It is very convenient to have a set of
introduction rules for this purpose (a lot should be added to it, I have put here all the ones
I needed).

The typical use case is when one wants to prove some inequality, say
$ \exp (x*x) \leq y + \exp(1 + z * z + y)$, assuming $y \geq 0$ and $0 \leq x \leq z$.
One would write it has
\begin{verbatim}
have "0 + \exp(0 + x * x + 0) < = y + \exp(1 + z * z + y)"
using `y > = 0` `x < = z` by (intro mono_intros)
\end{verbatim}
When the left and right hand terms are written in completely analogous ways as above, then the
introduction rules (that contain monotonicity of addition, of the exponential, and so on) reduce
this to comparison of elementary terms in the formula. This is a very naive strategy, that fails
in many situations, but that is very efficient when used correctly.
›

named_theorems mono_intros "structural introduction rules to prove inequalities"
declare le_imp_neg_le [mono_intros]
declare add_left_mono [mono_intros]
declare add_right_mono [mono_intros]
declare add_strict_left_mono [mono_intros]
declare add_strict_right_mono [mono_intros]
declare add_mono [mono_intros]
declare add_less_le_mono [mono_intros]
declare diff_right_mono [mono_intros]
declare diff_left_mono [mono_intros]
declare diff_mono [mono_intros]
declare mult_left_mono [mono_intros]
declare mult_right_mono [mono_intros]
declare mult_mono [mono_intros]
declare max.mono [mono_intros]
declare min.mono [mono_intros]
declare power_mono [mono_intros]
declare ln_ge_zero [mono_intros]
declare ln_le_minus_one [mono_intros]
declare ennreal_minus_mono [mono_intros]
declare ennreal_leI [mono_intros]
declare e2ennreal_mono [mono_intros]
declare enn2ereal_nonneg [mono_intros]
declare zero_le [mono_intros]
declare top_greatest [mono_intros]
declare bot_least [mono_intros]
declare dist_triangle [mono_intros]
declare dist_triangle2 [mono_intros]
declare dist_triangle3 [mono_intros]
declare exp_ge_add_one_self [mono_intros]
declare exp_gt_one [mono_intros]
declare exp_less_mono [mono_intros]
declare dist_triangle [mono_intros]
declare abs_triangle_ineq [mono_intros]
declare abs_triangle_ineq2 [mono_intros]
declare abs_triangle_ineq2_sym [mono_intros]
declare abs_triangle_ineq3 [mono_intros]
declare abs_triangle_ineq4 [mono_intros]
declare Liminf_le_Limsup [mono_intros]
declare ereal_liminf_add_mono [mono_intros]
declare le_of_int_ceiling [mono_intros]
declare ereal_minus_mono [mono_intros]
declare infdist_triangle [mono_intros]
declare divide_right_mono [mono_intros]
declare self_le_power [mono_intros]

lemma ln_le_cancelI [mono_intros]:
  assumes "(0::real) < x" "x  y"
  shows "ln x  ln y"
using assms by auto

lemma exp_le_cancelI [mono_intros]:
  assumes "x  (y::real)"
  shows "exp x  exp y"
using assms by simp

lemma mult_ge1_mono [mono_intros]:
  assumes "a  (0::'a::linordered_idom)" "b  1"
  shows "a  a * b" "a  b * a"
using assms mult_le_cancel_left1 mult_le_cancel_right1 by force+

text ‹A few convexity inequalities we will need later on.›

lemma xy_le_uxx_vyy [mono_intros]:
  assumes "u > 0" "u * v = (1::real)"
  shows "x * y  u * x^2/2 + v * y^2/2"
proof -
  have "v > 0" using assms
    by (metis (full_types) dual_order.strict_implies_order le_less_linear mult_nonneg_nonpos not_one_le_zero)
  then have *: "sqrt u * sqrt v = 1"
    using assms by (metis real_sqrt_mult real_sqrt_one)
  have "(sqrt u * x - sqrt v * y)^2  0" by auto
  then have "u * x^2 + v * y^2 - 2 * 1 * x * y  0"
    unfolding power2_eq_square *[symmetric] using u > 0 v > 0 by (auto simp add: algebra_simps)
  then show ?thesis by (auto simp add: algebra_simps divide_simps)
qed

lemma xy_le_xx_yy [mono_intros]:
  "x * y  x^2/2 + y^2/2" for x y::real
using xy_le_uxx_vyy[of 1 1] by auto

lemma ln_squared_bound [mono_intros]:
  "(ln x)^2  2 * x - 2" if "x  1" for x::real
proof -
  define f where "f = (λx::real. 2 * x - 2 - ln x * ln x)"
  have *: "DERIV f x :> 2 - 2 * ln x / x" if "x > 0" for x::real
    unfolding f_def using that by (auto intro!: derivative_eq_intros)
  have "f 1  f x" if "x  1" for x
  proof (rule DERIV_nonneg_imp_nondecreasing[OF that])
    fix t::real assume "t  1"
    show "y. (f has_real_derivative y) (at t)  0  y"
      apply (rule exI[of _ "2 - 2 * ln t / t"])
      using *[of t] t  1 by (auto simp add: divide_simps ln_bound)
  qed
  then show ?thesis unfolding f_def power2_eq_square using that by auto
qed

text ‹In the next lemma, the assumptions are too strong (negative numbers
less than $-1$ also work well to have a square larger than $1$), but in practice one proves
inequalities with nonnegative numbers, so this version is really the useful one for
\verb+mono_intros+.›

lemma mult_ge1_powers [mono_intros]:
  assumes "a  (1::'a::linordered_idom)"
  shows "1  a * a" "1  a * a * a" "1  a * a * a * a"
using assms by (meson assms dual_order.trans mult_ge1_mono(1) zero_le_one)+

lemmas [mono_intros] = ln_bound

lemma mono_cSup:
  fixes f :: "'a::conditionally_complete_lattice  'b::conditionally_complete_lattice"
  assumes "bdd_above A" "A  {}" "mono f"
  shows "Sup (f`A)  f (Sup A)"
by (metis assms(1) assms(2) assms(3) cSUP_least cSup_upper mono_def)

lemma mono_cSup_bij:
  fixes f :: "'a::conditionally_complete_linorder  'b::conditionally_complete_linorder"
  assumes "bdd_above A" "A  {}" "mono f" "bij f"
  shows "Sup (f`A) = f(Sup A)"
proof -
  have "Sup ((inv f)`(f`A))  (inv f) (Sup (f`A))"
    apply (rule mono_cSup)
    using mono_inv[OF assms(3) assms(4)] assms(2) bdd_above_image_mono[OF assms(3) assms(1)] by auto
  then have "f (Sup ((inv f)`(f`A)))  Sup (f`A)"
    using assms mono_def by (metis (no_types, hide_lams) bij_betw_imp_surj_on surj_f_inv_f)
  moreover have "f (Sup ((inv f)`(f`A))) = f(Sup A)"
    using assms by (simp add: bij_is_inj)
  ultimately show ?thesis using mono_cSup[OF assms(1) assms(2) assms(3)] by auto
qed

subsection ‹More topology›

text ‹In situations of interest to us later on, convergence is well controlled only for sequences
living in some dense subset of the space (but the limit can be anywhere). This is enough to
establish continuity of the function, if the target space is well enough separated.

The statement we give below is very general,
as we do not assume that the function is continuous inside the original set $S$, it will typically
only be continuous at a set $T$ contained in the closure of $S$. In many applications, $T$ will
be the closure of $S$, but we are also thinking of the case where one constructs an extension
of a function inside a space, to its boundary, and the behaviour at the boundary is better than
inside the space. The example we have in mind is the extension of a quasi-isometry to the boundary
of a Gromov hyperbolic space.

In the following criterion, we assume that if $u_n$ inside $S$ converges to a point at the boundary
$T$, then $f(u_n)$ converges (where $f$ is some function inside). Then, we can extend the function $f$ at
the boundary, by picking the limit value of $f(u_n)$ for some sequence converging to $u_n$. Then
the lemma asserts that $f$ is continuous at every point $b$ on the boundary.

The proof is done in two steps:
\begin{enumerate}
\item First, if $v_n$ is another inside sequence tending to
the same point $b$ on the boundary, then $f(v_n)$ converges to the same value as $f(u_n)$: this is
proved by considering the sequence $w$ equal to $u$ at even times and to $v$ at odd times, and
saying that $f(w_n)$ converges. Its limit is equal to the limit of $f(u_n)$ and of $f(v_n)$, so they
have to coincide.
\item Now, consider a general sequence $v$ (in the space or the boundary) converging to $b$. We want
to show that $f(v_n)$ tends to $f(b)$. If $v_n$ is inside $S$, we have already done it in the first
step. If it is on the boundary, on the other hand, we can approximate it by an inside point $w_n$
for which $f(w_n)$ is very close to $f(v_n)$. Then $w_n$ is an inside sequence converging to $b$,
hence $f(w_n)$ converges to $f(b)$ by the first step, and then $f(v_n)$ also converges to $f(b)$.
The precise argument is more conveniently written by contradiction. It requires good separation
properties of the target space.
\end{enumerate}›

text ‹First, we introduce the material to interpolate between two sequences, one at even times
and the other one at odd times.›

definition even_odd_interpolate::"(nat  'a)  (nat  'a)  (nat  'a)"
  where "even_odd_interpolate u v n = (if even n then u (n div 2) else v (n div 2))"

lemma even_odd_interpolate_compose:
  "even_odd_interpolate (f o u) (f o v) = f o (even_odd_interpolate u v)"
  unfolding even_odd_interpolate_def comp_def by auto

lemma even_odd_interpolate_filterlim:
  "filterlim u F sequentially  filterlim v F sequentially  filterlim (even_odd_interpolate u v) F sequentially"
proof (auto)
  assume H: "filterlim (even_odd_interpolate u v) F sequentially"
  define r::"nat  nat" where "r = (λn. 2 * n)"
  have "strict_mono r" unfolding r_def strict_mono_def by auto
  then have "filterlim r sequentially sequentially"
    by (simp add: filterlim_subseq)
  have "filterlim (λn. (even_odd_interpolate u v) (r n)) F sequentially"
    by (rule filterlim_compose[OF H filterlim_subseq[OF ‹strict_mono r]])
  moreover have "even_odd_interpolate u v (r n) = u n" for n
    unfolding r_def even_odd_interpolate_def by auto
  ultimately show "filterlim u F sequentially" by auto
  define r::"nat  nat" where "r = (λn. 2 * n + 1)"
  have "strict_mono r" unfolding r_def strict_mono_def by auto
  then have "filterlim r sequentially sequentially"
    by (simp add: filterlim_subseq)
  have "filterlim (λn. (even_odd_interpolate u v) (r n)) F sequentially"
    by (rule filterlim_compose[OF H filterlim_subseq[OF ‹strict_mono r]])
  moreover have "even_odd_interpolate u v (r n) = v n" for n
    unfolding r_def even_odd_interpolate_def by auto
  ultimately show "filterlim v F sequentially" by auto
next
  assume H: "filterlim u F sequentially" "filterlim v F sequentially"
  show "filterlim (even_odd_interpolate u v) F sequentially"
  unfolding filterlim_iff eventually_sequentially proof (auto)
    fix P assume *: "eventually P F"
    obtain N1 where N1: "n. n  N1  P (u n)"
      using H(1) unfolding filterlim_iff eventually_sequentially using * by auto
    obtain N2 where N2: "n. n  N2  P (v n)"
      using H(2) unfolding filterlim_iff eventually_sequentially using * by auto
    have "P (even_odd_interpolate u v n)" if "n  2 * N1 + 2 * N2" for n
    proof (cases "even n")
      case True
      have "n div 2  N1" using that by auto
      then show ?thesis unfolding even_odd_interpolate_def using True N1 by auto
    next
      case False
      have "n div 2  N2" using that by auto
      then show ?thesis unfolding even_odd_interpolate_def using False N2 by auto
    qed
    then show "N. n  N. P (even_odd_interpolate u v n)" by auto
  qed
qed

text ‹Then, we prove the continuity criterion for extensions of functions to the boundary $T$ of a set
$S$. The first assumption is that $f(u_n)$ converges when $f$ converges to the boundary, and the
second one that the extension of $f$ to the boundary has been defined using the limit along some
sequence tending to the point under consideration. The following criterion is the most general one,
but this is not the version that is most commonly applied so we use a prime in its name.›

lemma continuous_at_extension_sequentially':
  fixes f :: "'a::{first_countable_topology, t2_space}  'b::t3_space"
  assumes "b  T"
          "u b. (n. u n  S)  b  T  u  b  convergent (λn. f (u n))"
          "b. b  T  u. (n. u n  S)  u  b  ((λn. f (u n))  f b)"
  shows "continuous (at b within (S  T)) f"
proof -
  have first_step: "(λn. f (u n))  f c" if "n. u n  S" "u  c" "c  T" for u c
  proof -
    obtain v where v: "n. v n  S" "v  c" "(λn. f (v n))  f c"
      using assms(3)[OF c  T] by blast
    then have A: "even_odd_interpolate u v  c"
      unfolding even_odd_interpolate_filterlim[symmetric] using u  c by auto
    moreover have B: "n. even_odd_interpolate u v n  S"
      using n. u n  S n. v n  S unfolding even_odd_interpolate_def by auto
    have "convergent (λn. f (even_odd_interpolate u v n))"
      by (rule assms(2)[OF B c  T A])
    then obtain m where "(λn. f (even_odd_interpolate u v n))  m"
      unfolding convergent_def by auto
    then have "even_odd_interpolate (f o u) (f o v)  m"
      unfolding even_odd_interpolate_compose unfolding comp_def by auto
    then have "(f o u)  m" "(f o v)  m"
      unfolding even_odd_interpolate_filterlim[symmetric] by auto
    then have "m = f c" using v(3) unfolding comp_def using LIMSEQ_unique by auto
    then show ?thesis using (f o u)  m unfolding comp_def by auto
  qed
  show "continuous (at b within (S  T)) f"
  proof (rule ccontr)
    assume "¬ ?thesis"
    then obtain U where U: "open U" "f b  U" "¬(F x in at b within S  T. f x  U)"
      unfolding continuous_within tendsto_def[where l = "f b"] using sequentially_imp_eventually_nhds_within by auto
    have "V W. open V  open W  f b  V  (UNIV - U)  W  V  W = {}"
      apply (rule t3_space) using U by auto
    then obtain V W where VW: "open V" "open W" "f b  V" "UNIV - U  W" "V  W = {}"
      by auto

    obtain A :: "nat  'a set" where *:
      "i. open (A i)"
      "i. b  A i"
      "F. n. F n  A n  F  b"
      by (rule first_countable_topology_class.countable_basis) blast
    with * U(3) have "F. n. F n  S  T  F n  A n  ¬ (f(F n)  U)"
      unfolding at_within_def eventually_inf_principal eventually_nhds
      by (intro choice) (meson DiffE)
    then obtain F where F: "n. F n  S  T" "n. F n  A n" "n. f(F n)  U"
      by auto

    have "y. y  S  y  A n  f y  W" for n
    proof (cases "F n  S")
      case True
      show ?thesis apply (rule exI[of _ "F n"]) using F VW True by auto
    next
      case False
      then have "F n  T" using F n  S  T by auto
      obtain u where u: "p. u p  S" "u  F n" "(λp. f (u p))  f(F n)"
        using assms(3)[OF F n  T] by auto
      moreover have "f(F n)  W" using F VW by auto
      ultimately have "eventually (λp. f (u p)  W) sequentially"
        using ‹open W by (simp add: tendsto_def)
      moreover have "eventually (λp. u p  A n) sequentially"
        using F n  A n u ‹open (A n) by (simp add: tendsto_def)
      ultimately have "p. f(u p)  W  u p  A n"
        using eventually_False_sequentially eventually_elim2 by blast
      then show ?thesis using u(1) by auto
    qed
    then have "u. n. u n  S  u n  A n  f (u n)  W"
      by (auto intro: choice)
    then obtain u where u: "n. u n  S" "n. u n  A n" "n. f (u n)  W"
      by blast
    then have "u  b" using *(3) by auto
    then have "(λn. f (u n))  f b" using first_step assms u by auto
    then have "eventually (λn. f (u n)  V) sequentially"
      using VW by (simp add: tendsto_def)
    then have "n. f (u n)  V"
      using eventually_False_sequentially eventually_elim2 by blast
    then show False
      using u(3) V  W = {} by auto
  qed
qed

text ‹We can specialize the previous statement to the common case where one already knows the
sequential continuity of $f$ along sequences in $S$ converging to a point in $T$. This will be the
case in most --but not all-- applications. This is a straightforward application of the above
criterion.›

proposition continuous_at_extension_sequentially:
  fixes f :: "'a::{first_countable_topology, t2_space}  'b::t3_space"
  assumes "a  T"
          "T  closure S"
          "u b. (n. u n  S)  b  T  u  b  (λn. f (u n))  f b"
  shows "continuous (at a within (S  T)) f"
apply (rule continuous_at_extension_sequentially'[OF a  T])
using assms(3) convergent_def apply blast
by (metis assms(2) assms(3) closure_sequential subset_iff)

text ‹We also give global versions. We can only express the continuity on $T$, so
this is slightly weaker than the previous statements since we are not saying anything on inside
sequences tending to $T$ -- but in cases where $T$ contains $S$ these statements contain all the
information.›

lemma continuous_on_extension_sequentially':
  fixes f :: "'a::{first_countable_topology, t2_space}  'b::t3_space"
  assumes "u b. (n. u n  S)  b  T  u  b  convergent (λn. f (u n))"
          "b. b  T  u. (n. u n  S)  u  b  ((λn. f (u n))  f b)"
  shows "continuous_on T f"
unfolding continuous_on_eq_continuous_within apply (auto intro!: continuous_within_subset[of _ "S  T" f T])
by (intro continuous_at_extension_sequentially'[OF _ assms], auto)

lemma continuous_on_extension_sequentially:
  fixes f :: "'a::{first_countable_topology, t2_space}  'b::t3_space"
  assumes "T  closure S"
          "u b. (n. u n  S)  b  T  u  b  (λn. f (u n))  f b"
  shows "continuous_on T f"
unfolding continuous_on_eq_continuous_within apply (auto intro!: continuous_within_subset[of _ "S  T" f T])
by (intro continuous_at_extension_sequentially[OF _ assms], auto)


subsubsection ‹Homeomorphisms›

text ‹A variant around the notion of homeomorphism, which is only expressed in terms of the
function and not of its inverse.›

definition homeomorphism_on::"'a set  ('a::topological_space  'b::topological_space)  bool"
  where "homeomorphism_on S f = (g. homeomorphism S (f`S) f g)"

lemma homeomorphism_on_continuous:
  assumes "homeomorphism_on S f"
  shows "continuous_on S f"
using assms unfolding homeomorphism_on_def homeomorphism_def by auto

lemma homeomorphism_on_bij:
  assumes "homeomorphism_on S f"
  shows "bij_betw f S (f`S)"
using assms unfolding homeomorphism_on_def homeomorphism_def by auto (metis inj_on_def inj_on_imp_bij_betw)

lemma homeomorphism_on_homeomorphic:
  assumes "homeomorphism_on S f"
  shows "S homeomorphic (f`S)"
using assms unfolding homeomorphism_on_def homeomorphic_def by auto

lemma homeomorphism_on_compact:
  fixes f::"'a::topological_space  'b::t2_space"
  assumes "continuous_on S f"
          "compact S"
          "inj_on f S"
  shows "homeomorphism_on S f"
unfolding homeomorphism_on_def using homeomorphism_compact[OF assms(2) assms(1) _ assms(3)] by auto

lemma homeomorphism_on_subset:
  assumes "homeomorphism_on S f"
          "T  S"
  shows "homeomorphism_on T f"
using assms homeomorphism_of_subsets unfolding homeomorphism_on_def by blast

lemma homeomorphism_on_empty [simp]:
  "homeomorphism_on {} f"
unfolding homeomorphism_on_def using homeomorphism_empty[of f] by auto

lemma homeomorphism_on_cong:
  assumes "homeomorphism_on X f"
          "X' = X" "x. x  X  f' x = f x"
  shows "homeomorphism_on X' f'"
proof -
  obtain g where g:"homeomorphism X (f`X) f g"
    using assms unfolding homeomorphism_on_def by auto
  have "homeomorphism X' (f'`X') f' g"
    apply (rule homeomorphism_cong[OF g]) using assms by (auto simp add: rev_image_eqI)
  then show ?thesis
    unfolding homeomorphism_on_def by auto
qed

lemma homeomorphism_on_inverse:
  fixes f::"'a::topological_space  'b::topological_space"
  assumes "homeomorphism_on X f"
  shows "homeomorphism_on (f`X) (inv_into X f)"
proof -
  obtain g where g: "homeomorphism X (f`X) f g"
    using assms unfolding homeomorphism_on_def by auto
  then have "g`f`X = X"
    by (simp add: homeomorphism_def)
  then have "homeomorphism_on (f`X) g"
    unfolding homeomorphism_on_def using homeomorphism_symD[OF g] by auto
  moreover have "g x = inv_into X f x" if "x  f`X" for x
    using g that unfolding homeomorphism_def by (auto, metis f_inv_into_f inv_into_into that)
  ultimately show ?thesis
    using homeomorphism_on_cong by force
qed

text ‹Characterization of homeomorphisms in terms of sequences: a map is a homeomorphism if and
only if it respects convergent sequences.›

lemma homeomorphism_on_compose:
  assumes "homeomorphism_on S f"
          "x  S"
          "eventually (λn. u n  S) F"
  shows "(u  x) F  ((λn. f (u n))  f x) F"
proof
  assume "(u  x) F"
  then show "((λn. f (u n))  f x) F"
    using continuous_on_tendsto_compose[OF homeomorphism_on_continuous[OF assms(1)] _ assms(2) assms(3)] by simp
next
  assume *: "((λn. f (u n))  f x) F"
  have I: "inv_into S f (f y) = y" if "y  S" for y
    using homeomorphism_on_bij[OF assms(1)] by (meson bij_betw_inv_into_left that)
  then have A: "eventually (λn. u n = inv_into S f (f (u n))) F"
    using assms eventually_mono by force
  have "((λn. (inv_into S f) (f (u n)))  (inv_into S f) (f x)) F"
    apply (rule continuous_on_tendsto_compose[OF homeomorphism_on_continuous[OF homeomorphism_on_inverse[OF assms(1)]] *])
    using assms eventually_mono by (auto) fastforce
  then show "(u  x) F"
    unfolding tendsto_cong[OF A] I[OF x  S] by simp
qed

lemma homeomorphism_on_sequentially:
  fixes f::"'a::{first_countable_topology, t2_space}  'b::{first_countable_topology, t2_space}"
  assumes "x u. x  S  (n. u n  S)  u  x  (λn. f (u n))  f x"
  shows "homeomorphism_on S f"
proof -
  have "x = y" if "f x = f y" "x  S" "y  S" for x y
  proof -
    have "(λn. f x)  f y" using that by auto
    then have "(λn. x)  y" using assms(1) that by auto
    then show "x = y" using LIMSEQ_unique by auto
  qed
  then have "inj_on f S" by (simp add: inj_on_def)

  have Cf: "continuous_on S f"
    apply (rule continuous_on_sequentiallyI) using assms by auto
  define g where "g = inv_into S f"
  have Cg: "continuous_on (f`S) g"
  proof (rule continuous_on_sequentiallyI)
    fix v b assume H: "n. v n  f ` S" "b  f ` S" "v  b"
    define u where "u = (λn. g (v n))"
    define a where "a = g b"
    have "u n  S" "f (u n) = v n" for n
      unfolding u_def g_def using H(1) by (auto simp add: inv_into_into f_inv_into_f)
    have "a  S" "f a = b"
      unfolding a_def g_def using H(2) by (auto simp add: inv_into_into f_inv_into_f)
    show "(λn. g(v n))  g b"
      unfolding u_def[symmetric] a_def[symmetric] apply (rule iffD2[OF assms])
      using n. u n  S a  S v  b
      unfolding n. f (u n) = v n f a = b by auto
  qed
  have "homeomorphism S (f`S) f g"
    apply (rule homeomorphismI[OF Cf Cg]) unfolding g_def using ‹inj_on f S by auto
  then show ?thesis
    unfolding homeomorphism_on_def by auto
qed

lemma homeomorphism_on_UNIV_sequentially:
  fixes f::"'a::{first_countable_topology, t2_space}  'b::{first_countable_topology, t2_space}"
  assumes "x u. u  x  (λn. f (u n))  f x"
  shows "homeomorphism_on UNIV f"
using assms by (auto intro!: homeomorphism_on_sequentially)

text ‹Now, we give similar characterizations in terms of sequences living in a dense subset. As
in the sequential continuity criteria above, we first give a very general criterion, where the map
does not have to be continuous on the approximating set $S$, only on the limit set $T$, without
any a priori identification of the limit. Then, we specialize this statement to a less general
but often more usable version.›

lemma homeomorphism_on_extension_sequentially_precise:
  fixes f::"'a::{first_countable_topology, t3_space}  'b::{first_countable_topology, t3_space}"
  assumes "u b. (n. u n  S)  b  T  u  b  convergent (λn. f (u n))"
          "u c. (n. u n  S)  c  f`T  (λn. f (u n))  c  convergent u"
          "b. b  T  u. (n. u n  S)  u  b  ((λn. f (u n))  f b)"
          "n. u n  S  T" "l  T"
  shows "u  l  (λn. f (u n))  f l"
proof
  assume H: "u  l"
  have "continuous (at l within (S  T)) f"
    apply (rule continuous_at_extension_sequentially'[OF l  T]) using assms(1) assms(3) by auto
  then show "(λn. f (u n))  f l"
    apply (rule continuous_within_tendsto_compose) using H assms(4) by auto
next
  text ‹For the reverse implication, we would like to use the continuity criterion
  \verb+ continuous_at_extension_sequentially'+ applied to the inverse of $f$. Unfortunately, this
  inverse is only well defined on $T$, while our sequence takes values in $S \cup T$. So, instead,
  we redo by hand the proof of the continuity criterion, but in the opposite direction.›
  assume H: "(λn. f (u n))  f l"
  show "u  l"
  proof (rule ccontr)
    assume "¬ ?thesis"
    then obtain U where U: "open U" "l  U" "¬(F n in sequentially. u n  U)"
      unfolding continuous_within tendsto_def[where l = l] using sequentially_imp_eventually_nhds_within by auto
    obtain A :: "nat  'b set" where *:
      "i. open (A i)"
      "i. f l  A i"
      "F. n. F n  A n  F  f l"
      by (rule first_countable_topology_class.countable_basis) blast
    have B: "eventually (λn. f (u n)  A i) sequentially" for i
      using ‹open (A i) f l  A i H topological_tendstoD by fastforce
    have M: "r. r  N  (u r  U)  f (u r)  A i" for N i
      using U(3) B[of i] unfolding eventually_sequentially by (meson dual_order.trans le_cases)
    have "r. n. (u (r n)  U  f (u (r n))  A n)  r (Suc n)  r n + 1"
      apply (rule dependent_nat_choice) using M by auto
    then obtain r where r: "n. u (r n)  U" "n. f (u (r n))  A n" "n. r (Suc n)  r n + 1"
      by auto
    then have "strict_mono r"
      by (metis Suc_eq_plus1 Suc_le_lessD strict_monoI_Suc)

    have "V W. open V  open W  l  V  (UNIV - U)  W  V  W = {}"
      apply (rule t3_space) using U by auto
    then obtain V W where VW: "open V" "open W" "l  V" "UNIV - U  W" "V  W = {}"
      by auto

    have "z. z  S  f z  A n  z  W" for n
    proof -
      define z where "z = u (r n)"
      have "f z  A n" unfolding z_def using r(2) by auto
      have "z  S  T" "z  U"
        unfolding z_def using r(1) assms(4) by auto
      then have "z  W" using VW by auto
      show ?thesis
      proof (cases "z  T")
        case True
        obtain u::"nat  'a" where u: "p. u p  S" "u  z" "(λp. f (u p))  f z"
          using assms(3)[OF z  T] by auto
        then have "eventually (λp. f (u p)  A n) sequentially"
          using ‹open (A n) f z  A n unfolding tendsto_def by simp
        moreover have "eventually (λp. u p  W) sequentially"
          using ‹open W z  W u unfolding tendsto_def by simp
        ultimately have "p. u p  W  f (u p)  A n"
          using eventually_False_sequentially eventually_elim2 by blast
        then show ?thesis using u(1) by auto
      next
        case False
        then have "z  S" using z  S  T by auto
        then show ?thesis using f z  A n z  W by auto
      qed
    qed
    then have "v. n. v n  S  f (v n)  A n  v n  W"
      by (auto intro: choice)
    then obtain v where v: "n. v n  S" "n. f (v n)  A n" "n. v n  W"
      by blast
    then have I: "(λn. f (v n))  f l" using *(3) by auto

    obtain w where w: "n. w n  S" "w  l" "((λn. f (w n))  f l)"
      using assms(3)[OF l  T] by auto
    have "even_odd_interpolate (f o v) (f o w)  f l"
      unfolding even_odd_interpolate_filterlim[symmetric] comp_def using v w I by auto
    then have *: "(λn. f (even_odd_interpolate v w n))  f l"
      unfolding even_odd_interpolate_compose unfolding comp_def by auto
    have "convergent (even_odd_interpolate v w)"
      apply (rule assms(2)[OF _ _ *])
      unfolding even_odd_interpolate_def using v(1) w(1) l  T by auto
    then obtain z where "even_odd_interpolate v w  z"
      unfolding convergent_def by auto
    then have *: "v  z" "w  z" unfolding even_odd_interpolate_filterlim[symmetric] by auto
    then have "z = l" using v(2) w(2) LIMSEQ_unique by auto
    then have "v  l" using * by simp
    then have "eventually (λn. v n  V) sequentially"
      using VW by (simp add: tendsto_def)
    then have "n. v n  V"
      using eventually_False_sequentially eventually_elim2 by blast
    then show False
      using v(3) V  W = {} by auto
  qed
qed

lemma homeomorphism_on_extension_sequentially':
  fixes f::"'a::{first_countable_topology, t3_space}  'b::{first_countable_topology, t3_space}"
  assumes "u b. (n. u n  S)  b  T  u  b  convergent (λn. f (u n))"
          "u c. (n. u n  S)  c  f`T  (λn. f (u n))  c  convergent u"
          "b. b  T  u. (n. u n  S)  u  b  ((λn. f (u n))  f b)"
  shows "homeomorphism_on T f"
apply (rule homeomorphism_on_sequentially, rule homeomorphism_on_extension_sequentially_precise[of S T])
using assms by auto

proposition homeomorphism_on_extension_sequentially:
  fixes f::"'a::{first_countable_topology, t3_space}  'b::{first_countable_topology, t3_space}"
  assumes "u b. (n. u n  S)  u  b  (λn. f (u n))  f b"
          "T  closure S"
  shows "homeomorphism_on T f"
apply (rule homeomorphism_on_extension_sequentially'[of S])
using assms(1) convergent_def apply fastforce
using assms(1) convergent_def apply blast
by (metis assms(1) assms(2) closure_sequential subsetCE)

lemma homeomorphism_on_UNIV_extension_sequentially:
  fixes f::"'a::{first_countable_topology, t3_space}  'b::{first_countable_topology, t3_space}"
  assumes "u b. (n. u n  S)  u  b  (λn. f (u n))  f b"
          "closure S = UNIV"
  shows "homeomorphism_on UNIV f"
apply (rule homeomorphism_on_extension_sequentially[of S]) using assms by auto


subsubsection ‹Proper spaces›

text ‹Proper spaces, i.e., spaces in which every closed ball is compact -- or, equivalently,
any closed bounded set is compact.›

definition proper::"('a::metric_space) set  bool"
  where "proper S  ( x r. compact (cball x r  S))"

lemma properI:
  assumes "x r. compact (cball x r  S)"
  shows "proper S"
using assms unfolding proper_def by auto

lemma proper_compact_cball:
  assumes "proper (UNIV::'a::metric_space set)"
  shows "compact (cball (x::'a) r)"
using assms unfolding proper_def by auto

lemma proper_compact_bounded_closed:
  assumes "proper (UNIV::'a::metric_space set)" "closed (S::'a set)" "bounded S"
  shows "compact S"
proof -
  obtain x r where "S  cball x r"
    using ‹bounded S bounded_subset_cball by blast
  then have *: "S = S  cball x r"
    by auto
  show ?thesis
    apply (subst *, rule closed_Int_compact) using assms unfolding proper_def by auto
qed

lemma proper_real [simp]:
  "proper (UNIV::real set)"
unfolding proper_def by auto

lemma complete_of_proper:
  assumes "proper S"
  shows "complete S"
proof -
  have "lS. u  l" if "Cauchy u" "n. u n  S" for u
  proof -
    have "bounded (range u)"
      using ‹Cauchy u cauchy_imp_bounded by auto
    then obtain x r where *: "n. dist x (u n)  r"
      unfolding bounded_def by auto
    then have "u n  (cball x r)  S" for n using u n  S by auto
    moreover have "complete ((cball x r)  S)"
      apply (rule compact_imp_complete) using assms unfolding proper_def by auto
    ultimately show ?thesis
      unfolding complete_def using ‹Cauchy u by auto
  qed
  then show ?thesis
    unfolding complete_def by auto
qed

lemma proper_of_compact:
  assumes "compact S"
  shows "proper S"
using assms by (auto intro: properI)

lemma proper_Un:
  assumes "proper A" "proper B"
  shows "proper (A  B)"
using assms unfolding proper_def by (auto simp add: compact_Un inf_sup_distrib1)

subsubsection ‹Miscellaneous topology›

text ‹When manipulating the triangle inequality, it is very frequent to deal with 4 points
(and automation has trouble doing it automatically). Even sometimes with 5 points...›

lemma dist_triangle4 [mono_intros]:
  "dist x t  dist x y + dist y z + dist z t"
using dist_triangle[of x z y] dist_triangle[of x t z] by auto

lemma dist_triangle5 [mono_intros]:
  "dist x u  dist x y + dist y z + dist z t + dist t u"
using dist_triangle4[of x u y z] dist_triangle[of z u t] by auto

text ‹A thickening of a compact set is closed.›

lemma compact_has_closed_thickening:
  assumes "compact C"
          "continuous_on C f"
  shows "closed (xC. cball x (f x))"
proof (auto simp add: closed_sequential_limits)
  fix u l assume *: "n::nat. xC. dist x (u n)  f x" "u  l"
  have "x::nat'a. n. x n  C  dist (x n) (u n)  f (x n)"
    apply (rule choice) using * by auto
  then obtain x::"nat  'a" where x: "n. x n  C" "n. dist (x n) (u n)  f (x n)"
    by blast
  obtain r c where "strict_mono r" "c  C" "(x o r)  c"
    using x(1) ‹compact C by (meson compact_eq_seq_compact_metric seq_compact_def)
  then have "c  C" using x(1) ‹compact C by auto
  have lim: "(λn. f (x (r n)) - dist (x (r n)) (u (r n)))  f c - dist c l"
    apply (intro tendsto_intros, rule continuous_on_tendsto_compose[of C f])
    using *(2) x(1) (x o r)  c ‹continuous_on C f c  C ‹strict_mono r LIMSEQ_subseq_LIMSEQ
    unfolding comp_def by auto
  have "f c - dist c l  0" apply (rule LIMSEQ_le_const[OF lim]) using x(2) by auto
  then show "xC. dist x l  f x" using c  C by auto
qed

text ‹congruence rule for continuity. The assumption that $f y = g y$ is necessary since \verb+at x+
is the pointed neighborhood at $x$.›

lemma continuous_within_cong:
  assumes "continuous (at y within S) f"
          "eventually (λx. f x = g x) (at y within S)"
          "f y = g y"
  shows "continuous (at y within S) g"
  using assms continuous_within filterlim_cong by fastforce

text ‹A function which tends to infinity at infinity, on a proper set, realizes its infimum›

lemma continuous_attains_inf_proper:
  fixes f :: "'a::metric_space  'b::linorder_topology"
  assumes "proper s" "a  s"
          "continuous_on s f"
          "z. z  s - cball a r  f z  f a"
  shows "xs. ys. f x  f y"
proof (cases "r  0")
  case True
  have "xcball a r  s. y  cball a r  s. f x  f y"
    apply (rule continuous_attains_inf) using assms True unfolding proper_def apply (auto simp add: continuous_on_subset)
    using centre_in_cball by blast
  then obtain x where x: "x  cball a r  s" "y. y  cball a r  s  f x  f y"
    by auto
  have "f x  f y" if "y  s" for y
  proof (cases "y  cball a r")
    case True
    then show ?thesis using x(2) that by auto
  next
    case False
    have "f x  f a"
      apply (rule x(2)) using assms True by auto
    then show ?thesis using assms(4)[of y] that False by auto
  qed
  then show ?thesis using x(1) by auto
next
  case False
  show ?thesis
    apply (rule bexI[of _ a]) using assms False by auto
qed

subsubsection ‹Measure of balls›

text ‹The image of a ball by an affine map is still a ball, with explicit center and radius. (Now unused)›

lemma affine_image_ball [simp]:
  "(λy. R *R y + x) ` cball 0 1 = cball (x::('a::real_normed_vector)) ¦R¦"
proof
  have "dist x (R *R y + x)  ¦R¦" if "dist 0 y  1" for y
  proof -
    have "dist x (R *R y + x) = norm ((R *R y + x) - x)" by (simp add: dist_norm)
    also have "... = ¦R¦ * norm y" by auto
    finally show ?thesis using that by (simp add: mult_left_le)
  qed
  then show "(λy. R *R y + x) ` cball 0 1  cball x ¦R¦" by auto

  show "cball x ¦R¦  (λy. R *R y + x) ` cball 0 1"
  proof (cases "¦R¦ = 0")
    case True
    then have "cball x ¦R¦ = {x}" by auto
    moreover have "x = R *R 0 + x  0  cball 0 1" by auto
    ultimately show ?thesis by auto
  next
    case False
    have "z  (λy. R *R y + x) ` cball 0 1" if "z  cball x ¦R¦" for z
    proof -
      define y where "y = (z - x) /R R"
      have "R *R y + x = z" unfolding y_def using False by auto
      moreover have "y  cball 0 1"
        using z  cball x ¦R¦ False unfolding y_def by (auto simp add: dist_norm[symmetric] divide_simps dist_commute)
      ultimately show ?thesis by auto
    qed
    then show ?thesis by auto
  qed
qed

text ‹From the rescaling properties of Lebesgue measure in a euclidean space, it follows that
the measure of any ball can be expressed in terms of the measure of the unit ball.›

lemma lebesgue_measure_ball:
  assumes "R  0"
  shows "measure lborel (cball (x::('a::euclidean_space)) R) = R^(DIM('a)) * measure lborel (cball (0::'a) 1)"
        "emeasure lborel (cball (x::('a::euclidean_space)) R) = R^(DIM('a)) * emeasure lborel (cball (0::'a) 1)"
  apply (simp add: assms content_cball)
  by (simp add: assms emeasure_cball ennreal_mult' ennreal_power mult.commute)

text ‹We show that the unit ball has positive measure -- this is obvious, but useful. We could
show it by arguing that it contains a box, whose measure can be computed, but instead we say
that if the measure vanished then the measure of any ball would also vanish, contradicting the
fact that the space has infinite measure. This avoids all computations.›

lemma lebesgue_measure_ball_pos:
  "emeasure lborel (cball (0::'a::euclidean_space) 1) > 0"
  "measure lborel (cball (0::'a::euclidean_space) 1) > 0"
proof -
  show "emeasure lborel (cball (0::'a::euclidean_space) 1) > 0"
  proof (rule ccontr)
    assume "¬(emeasure lborel (cball (0::'a::euclidean_space) 1) > 0)"
    then have "emeasure lborel (cball (0::'a) 1) = 0" by auto
    then have "emeasure lborel (cball (0::'a) n) = 0" for n::nat
      using lebesgue_measure_ball(2)[of "real n" 0] by (metis mult_zero_right of_nat_0_le_iff)
    then have "emeasure lborel (n. cball (0::'a) (real n)) = 0"
      by (metis (mono_tags, lifting) borel_closed closed_cball emeasure_UN_eq_0 imageE sets_lborel subsetI)
    moreover have "(n. cball (0::'a) (real n)) = UNIV" by (auto simp add: real_arch_simple)
    ultimately show False
      by simp
  qed
  moreover have "emeasure lborel (cball (0::'a::euclidean_space) 1) < "
    by (rule emeasure_bounded_finite, auto)
  ultimately show "measure lborel (cball (0::'a::euclidean_space) 1) > 0"
    by (metis borel_closed closed_cball ennreal_0 has_integral_iff_emeasure_lborel has_integral_measure_lborel less_irrefl order_refl zero_less_measure_iff)
qed

subsubsection ‹infdist and closest point projection›

text ‹The distance to a union of two sets is the minimum of the distance to the two sets.›

lemma infdist_union_min [mono_intros]:
  assumes "A  {}" "B  {}"
  shows "infdist x (A  B) = min (infdist x A) (infdist x B)"
using assms by (simp add: infdist_def cINF_union inf_real_def)

text ‹The distance to a set is non-increasing with the set.›

lemma infdist_mono [mono_intros]:
  assumes "A  B" "A  {}"
  shows "infdist x B  infdist x A"
  by (simp add: assms infdist_eq_setdist setdist_subset_right)

text ‹If a set is proper, then the infimum of the distances to this set is attained.›

lemma infdist_proper_attained:
  assumes "proper C" "C  {}"
  shows "cC. infdist x C = dist x c"
proof -
  obtain a where "a  C" using assms by auto
  have *: "dist x a  dist x z" if "dist a z  2 * dist a x" for z
  proof -
    have "2 * dist a x  dist a z" using that by simp
    also have "...  dist a x + dist x z" by (intro mono_intros)
    finally show ?thesis by (simp add: dist_commute)
  qed
  have "cC. dC. dist x c  dist x d"
    apply (rule continuous_attains_inf_proper[OF assms(1) a  C, of _ "2 * dist a x"])
    using * by (auto intro: continuous_intros)
  then show ?thesis unfolding infdist_def using C  {}
    by (metis antisym bdd_below_image_dist cINF_lower le_cINF_iff)
qed

lemma infdist_almost_attained:
  assumes "infdist x X < a" "X  {}"
  shows "yX. dist x y < a"
using assms using cInf_less_iff[of "(dist x)`X"] unfolding infdist_def by auto

lemma infdist_triangle_abs [mono_intros]:
  "¦infdist x A - infdist y A¦  dist x y"
by (metis (full_types) abs_diff_le_iff diff_le_eq dist_commute infdist_triangle)

text ‹The next lemma is missing in the library, contrary to its cousin \verb+continuous_infdist+.›

text ‹The infimum of the distance to a singleton set is simply the distance to the unique
member of the set.›

text ‹The closest point projection of $x$ on $A$. It is not unique, so we choose one point realizing the minimal
distance. And if there is no such point, then we use $x$, to make some statements true without any
assumption.›

definition proj_set::"'a::metric_space  'a set  'a set"
  where "proj_set x A = {y  A. dist x y = infdist x A}"

definition distproj::"'a::metric_space  'a set  'a"
  where "distproj x A = (if proj_set x A  {} then SOME y. y  proj_set x A else x)"

lemma proj_setD:
  assumes "y  proj_set x A"
  shows "y  A" "dist x y = infdist x A"
using assms unfolding proj_set_def by auto

lemma proj_setI:
  assumes "y  A" "dist x y  infdist x A"
  shows "y  proj_set x A"
using assms infdist_le[OF y  A, of x] unfolding proj_set_def by auto

lemma proj_setI':
  assumes "y  A" "z. z  A  dist x y  dist x z"
  shows "y  proj_set x A"
proof (rule proj_setI[OF y  A])
  show "dist x y  infdist x A"
    apply (subst infdist_notempty)
    using assms by (auto intro!: cInf_greatest)
qed

lemma distproj_in_proj_set:
  assumes "proj_set x A  {}"
  shows "distproj x A  proj_set x A"
        "distproj x A  A"
        "dist x (distproj x A) = infdist x A"
proof -
  show "distproj x A  proj_set x A"
    using assms unfolding distproj_def using some_in_eq by auto
  then show "distproj x A  A" "dist x (distproj x A) = infdist x A"
    unfolding proj_set_def by auto
qed

lemma proj_set_nonempty_of_proper:
  assumes "proper A" "A  {}"
  shows "proj_set x A  {}"
proof -
  have "y. y  A  dist x y = infdist x A"
    using infdist_proper_attained[OF assms, of x] by auto
  then show "proj_set x A  {}" unfolding proj_set_def by auto
qed

lemma distproj_self [simp]:
  assumes "x  A"
  shows "proj_set x A = {x}"
        "distproj x A = x"
proof -
  show "proj_set x A = {x}"
    unfolding proj_set_def using assms by auto
  then show "distproj x A = x"
    unfolding distproj_def by auto
qed

lemma distproj_closure [simp]:
  assumes "x  closure A"
  shows "distproj x A = x"
proof (cases "proj_set x A  {}")
  case True
  show ?thesis
    using distproj_in_proj_set(3)[OF True] assms
    by (metis closure_empty dist_eq_0_iff distproj_self(2) in_closure_iff_infdist_zero)
next
  case False
  then show ?thesis unfolding distproj_def by auto
qed

lemma distproj_le:
  assumes "y  A"
  shows "dist x (distproj x A)  dist x y"
proof (cases "proj_set x A  {}")
  case True
  show ?thesis using distproj_in_proj_set(3)[OF True] infdist_le[OF assms] by auto
next
  case False
  then show ?thesis unfolding distproj_def by auto
qed

lemma proj_set_dist_le:
  assumes "y  A" "p  proj_set x A"
  shows "dist x p  dist x y"
  using assms infdist_le unfolding proj_set_def by auto

subsection ‹Material on ereal and ennreal›

text ‹We add the simp rules that we needed to make all computations become more or less automatic.›

lemma ereal_of_real_of_ereal_iff [simp]:
  "ereal(real_of_ereal x) = x  x    x  - "
  "x = ereal(real_of_ereal x)  x    x  - "
by (metis MInfty_neq_ereal(1) PInfty_neq_ereal(2) real_of_ereal.elims)+

declare ereal_inverse_eq_0 [simp]
declare ereal_0_gt_inverse [simp]
declare ereal_inverse_le_0_iff [simp]
declare ereal_divide_eq_0_iff [simp]
declare ereal_mult_le_0_iff [simp]
declare ereal_zero_le_0_iff [simp]
declare ereal_mult_less_0_iff [simp]
declare ereal_zero_less_0_iff [simp]
declare ereal_uminus_eq_reorder [simp]
declare ereal_minus_le_iff [simp]

lemma ereal_inverse_noteq_minus_infinity [simp]:
  "1/(x::ereal)  -"
by (simp add: divide_ereal_def)

lemma ereal_inverse_positive_iff_nonneg_not_infinity [simp]:
  "0 < 1/(x::ereal)  (x  0  x  )"
by (cases x, auto simp add: one_ereal_def)

lemma ereal_inverse_negative_iff_nonpos_not_infinity' [simp]:
  "0 > inverse (x::ereal)  (x < 0  x  -)"
by (cases x, auto simp add: one_ereal_def)

lemma ereal_divide_pos_iff [simp]:
  "0 < x/(y::ereal)  (y    y  -)  ((x > 0  y > 0)  (x < 0  y < 0)  (y = 0  x > 0))"
unfolding divide_ereal_def by auto

lemma ereal_divide_neg_iff [simp]:
  "0 > x/(y::ereal)  (y    y  -)  ((x > 0  y < 0)  (x < 0  y > 0)  (y = 0  x < 0))"
unfolding divide_ereal_def by auto

text ‹More additions to \verb+mono_intros+.›

lemma ereal_leq_imp_neg_leq [mono_intros]:
  fixes x y::ereal
  assumes "x  y"
  shows "-y  -x"
using assms by auto

lemma ereal_le_imp_neg_le [mono_intros]:
  fixes x y::ereal
  assumes "x < y"
  shows "-y < -x"
using assms by auto

declare ereal_mult_left_mono [mono_intros]
declare ereal_mult_right_mono [mono_intros]
declare ereal_mult_strict_right_mono [mono_intros]
declare ereal_mult_strict_left_mono [mono_intros]

text ‹Monotonicity of basic inclusions.›

lemma ennreal_mono':
  "mono ennreal"
by (simp add: ennreal_leI monoI)

lemma enn2ereal_mono':
  "mono enn2ereal"
by (simp add: less_eq_ennreal.rep_eq mono_def)

lemma e2ennreal_mono':
  "mono e2ennreal"
by (simp add: e2ennreal_mono mono_def)

lemma enn2ereal_mono [mono_intros]:
  assumes "x  y"
  shows "enn2ereal x  enn2ereal y"
using assms less_eq_ennreal.rep_eq by auto

lemma ereal_mono:
  "mono ereal"
unfolding mono_def by auto

lemma ereal_strict_mono:
  "strict_mono ereal"
unfolding strict_mono_def by auto

lemma ereal_mono2 [mono_intros]:
  assumes "x  y"
  shows "ereal x  ereal y"
by (simp add: assms)

lemma ereal_strict_mono2 [mono_intros]:
  assumes "x < y"
  shows "ereal x < ereal y"
using assms by auto

lemma enn2ereal_a_minus_b_plus_b [mono_intros]:
  "enn2ereal a  enn2ereal (a - b) + enn2ereal b"
by (metis diff_add_self_ennreal less_eq_ennreal.rep_eq linear plus_ennreal.rep_eq)

text ‹The next lemma follows from the same assertion in ereals.›

lemma enn2ereal_strict_mono [mono_intros]:
  assumes "x < y"
  shows "enn2ereal x < enn2ereal y"
using assms less_ennreal.rep_eq by auto

declare ennreal_mult_strict_left_mono [mono_intros]
declare ennreal_mult_strict_right_mono [mono_intros]

lemma ennreal_ge_0 [mono_intros]:
  assumes "0 < x"
  shows "0 < ennreal x"
by (simp add: assms)


text ‹The next lemma is true and useful in ereal. Note that variants such as $a + b \leq c + d$
implies $a-d \leq c -b$ are not true -- take $a = c = \infty$ and $b = d = 0$...›

lemma ereal_minus_le_minus_plus [mono_intros]:
  fixes a b c::ereal
  assumes "a  b + c"
  shows "-b  -a + c"
  using assms apply (cases a, cases b, cases c, auto)
  using ereal_infty_less_eq2(2) ereal_plus_1(4) by fastforce

lemma tendsto_ennreal_0 [tendsto_intros]:
  assumes "(u  0) F"
  shows "((λn. ennreal(u n))  0) F"
unfolding ennreal_0[symmetric] by (intro tendsto_intros assms)

lemma tendsto_ennreal_1 [tendsto_intros]:
  assumes "(u  1) F"
  shows "((λn. ennreal(u n))  1) F"
unfolding ennreal_1[symmetric] by (intro tendsto_intros assms)

subsection ‹Miscellaneous›

lemma lim_ceiling_over_n [tendsto_intros]:
  assumes "(λn. u n/n)  l"
  shows "(λn. ceiling(u n)/n)  l"
proof (rule tendsto_sandwich[of "λn. u n/n" _ _ "λn. u n/n + 1/n"])
  show "F n in sequentially. u n / real n  real_of_int u n / real n"
    unfolding eventually_sequentially by (rule exI[of _ 1], auto simp add: divide_simps)
  show "F n in sequentially. real_of_int u n / real n  u n / real n + 1 / real n"
    unfolding eventually_sequentially by (rule exI[of _ 1], auto simp add: divide_simps)
  have "(λn. u n / real n + 1 / real n)  l + 0"
    by (intro tendsto_intros assms)
  then show "(λn. u n / real n + 1 / real n)  l" by auto
qed (simp add: assms)

subsubsection ‹Liminfs and Limsups›

text ‹More facts on liminfs and limsups›

lemma Limsup_obtain':
  fixes u::"'a  'b::complete_linorder"
  assumes "Limsup F u > c" "eventually P F"
  shows "n. P n  u n > c"
proof -
  have *: "(INF P{P. eventually P F}. SUP x{x. P x}. u x) > c" using assms by (simp add: Limsup_def)
  have **: "c < (SUP x{x. P x}. u x)" using less_INF_D[OF *, of P] assms by auto
  then show ?thesis by (simp add: less_SUP_iff)
qed

lemma limsup_obtain:
  fixes u::"nat  'a :: complete_linorder"
  assumes "limsup u > c"
  shows "n  N. u n > c"
using Limsup_obtain'[OF assms, of "λn. n  N"] unfolding eventually_sequentially by auto

lemma Liminf_obtain':
  fixes u::"'a  'b::complete_linorder"
  assumes "Liminf F u < c" "eventually P F"
  shows "n. P n  u n < c"
proof -
  have *: "(SUP P{P. eventually P F}. INF x{x. P x}. u x) < c" using assms by (simp add: Liminf_def)
  have **: "(INF x{x. P x}. u x) < c" using SUP_lessD[OF *, of P] assms by auto
  then show ?thesis by (simp add: INF_less_iff)
qed

lemma liminf_obtain:
  fixes u::"nat  'a :: complete_linorder"
  assumes "liminf u < c"
  shows "n  N. u n < c"
using Liminf_obtain'[OF assms, of "λn. n  N"] unfolding eventually_sequentially by auto

text ‹The Liminf of a minimum is the minimum of the Liminfs.›

lemma Liminf_min_eq_min_Liminf:
  fixes u v::"nat  'a::complete_linorder"
  shows "Liminf F (λn. min (u n) (v n)) = min (Liminf F u) (Liminf F v)"
proof (rule order_antisym)
  show "Liminf F (λn. min (u n) (v n))  min (Liminf F u) (Liminf F v)"
    by (auto simp add: Liminf_mono)

  have "Liminf F (λn. min (u n) (v n)) > w" if H: "min (Liminf F u) (Liminf F v) > w" for w
  proof (cases "{w<..<min (Liminf F u) (Liminf F v)} = {}")
    case True
    have "eventually (λn. u n > w) F" "eventually (λn. v n > w) F"
      using H le_Liminf_iff by fastforce+
    then have "eventually (λn. min (u n) (v n) > w) F"
      apply auto using eventually_elim2 by fastforce
    moreover have "z > w  z  min (Liminf F u) (Liminf F v)" for z
      using H True not_le_imp_less by fastforce
    ultimately have "eventually (λn. min (u n) (v n)  min (Liminf F u) (Liminf F v)) F"
      by (simp add: eventually_mono)
    then have "min (Liminf F u) (Liminf F v)  Liminf F (λn. min (u n) (v n))"
      by (metis Liminf_bounded)
    then show ?thesis using H less_le_trans by blast
  next
    case False
    then obtain z where "z  {w<..<min (Liminf F u) (Liminf F v)}"
      by blast
    then have H: "w < z" "z < min (Liminf F u) (Liminf F v)"
      by auto
    then have "eventually (λn. u n > z) F" "eventually (λn. v n > z) F"
      using le_Liminf_iff by fastforce+
    then have "eventually (λn. min (u n) (v n) > z) F"
      apply auto using eventually_elim2 by fastforce
    then have "Liminf F (λn. min (u n) (v n))  z"
      by (simp add: Liminf_bounded eventually_mono less_imp_le)
    then show ?thesis using H(1)
      by auto
  qed
  then show "min (Liminf F u) (Liminf F v)  Liminf F (λn. min (u n) (v n))"
    using not_le_imp_less by blast
qed

text ‹The Limsup of a maximum is the maximum of the Limsups.›

lemma Limsup_max_eq_max_Limsup:
  fixes u::"'a  'b::complete_linorder"
  shows "Limsup F (λn. max (u n) (v n)) = max (Limsup F u) (Limsup F v)"
proof (rule order_antisym)
  show "max (Limsup F u) (Limsup F v)  Limsup F (λn. max (u n) (v n))"
    by (auto intro: Limsup_mono)

  have "Limsup F (λn. max (u n) (v n)) < e" if "max (Limsup F u) (Limsup F v) < e" for e
  proof (cases "t. max (Limsup F u) (Limsup F v) < t  t < e")
    case True
    then obtain t where t: "t < e" "max (Limsup F u) (Limsup F v) < t" by auto
    then have "Limsup F u < t" "Limsup F v < t" using that max_def by auto
    then have *: "eventually (λn. u n < t) F" "eventually (λn. v n < t) F"
      by (auto simp: Limsup_lessD)
    have "eventually (λn. max (u n) (v n) < t) F"
      using eventually_mono[OF eventually_conj[OF *]] by auto
    then have "Limsup F (λn. max (u n) (v n))  t"
      by (meson Limsup_obtain' not_le_imp_less order.asym)
    then show ?thesis
      using t by auto
  next
    case False
    have "Limsup F u < e" "Limsup F v < e" using that max_def by auto
    then have *: "eventually (λn. u n < e) F" "eventually (λn. v n < e) F"
      by (auto simp: Limsup_lessD)
    have "eventually (λn. max (u n) (v n)  max (Limsup F u) (Limsup F v)) F"
      apply (rule eventually_mono[OF eventually_conj[OF *]]) using False not_le_imp_less by force
    then have "Limsup F (λn. max (u n) (v n))  max (Limsup F u) (Limsup F v)"
      by (meson Limsup_obtain' leD leI)
    then show ?thesis using that le_less_trans by blast
  qed
  then show "Limsup F (λn. max (u n) (v n))  max (Limsup F u) (Limsup F v)"
    using not_le_imp_less by blast
qed

subsubsection ‹Bounding the cardinality of a finite set›

text ‹A variation with real bounds.›

lemma finite_finite_subset_caract':
  fixes C::real
  assumes "G. G  F  finite G  card G  C"
  shows "finite F  card F  C"
by (meson assms finite_if_finite_subsets_card_bdd le_nat_floor order_refl)

text ‹To show that a set has cardinality at most one, it suffices to show that any two of its
elements coincide.›

lemma finite_at_most_singleton:
  assumes "x y. x  F  y  F  x = y"
  shows "finite F  card F  1"
proof (cases "F = {}")
  case True
  then show ?thesis by auto
next
  case False
  then obtain x where "x  F" by auto
  then have "F = {x}" using assms by auto
  then show ?thesis by auto
qed

text ‹Bounded sets of integers are finite.›

lemma finite_real_int_interval [simp]:
  "finite (range real_of_int  {a..b})"
proof -
  have "range real_of_int  {a..b}  real_of_int`{floor a..ceiling b}"
    by (auto, metis atLeastAtMost_iff ceiling_mono ceiling_of_int floor_mono floor_of_int image_eqI)
  then show ?thesis using finite_subset by blast
qed

text ‹Well separated sets of real numbers are finite, with controlled cardinality.›

lemma separated_in_real_card_bound:
  assumes "T  {a..(b::real)}" "d > 0" "x y. x  T  y  T  y > x  y  x + d"
  shows "finite T" "card T  nat (floor ((b-a)/d) + 1)"
proof -
  define f where "f = (λx. floor ((x-a) / d))"
  have "f`{a..b}  {0..floor ((b-a)/d)}"
    unfolding f_def using d > 0 by (auto simp add: floor_mono frac_le)
  then have *: "f`T  {0..floor ((b-a)/d)}" using T  {a..b} by auto
  then have "finite (f`T)" by (rule finite_subset, auto)
  have "card (f`T)  card {0..floor ((b-a)/d)}" apply (rule card_mono) using * by auto
  then have card_le: "card (f`T)  nat (floor ((b-a)/d) + 1)" using card_atLeastAtMost_int by auto

  have *: "f x  f y" if "y  x + d" for x y
  proof -
    have "(y-a)/d  (x-a)/d + 1" using d > 0 that by (auto simp add: divide_simps)
    then show ?thesis unfolding f_def by linarith
  qed
  have "inj_on f T"
    unfolding inj_on_def using * assms(3) by (auto, metis not_less_iff_gr_or_eq)
  show "finite T"
    using ‹finite (f`T) ‹inj_on f T finite_image_iff by blast
  have "card T = card (f`T)"
    using ‹inj_on f T by (simp add: card_image)
  then show "card T  nat (floor ((b-a)/d) + 1)"
    using card_le by auto
qed


subsection ‹Manipulating finite ordered sets›

text ‹We will need below to construct finite sets of real numbers with good properties expressed
in terms of consecutive elements of the set. We introduce tools to manipulate such sets,
expressing in particular the next and the previous element of the set and controlling how they
evolve when one inserts a new element in the set. It works in fact in any linorder, and could
also prove useful to construct sets of integer numbers.

Manipulating the next and previous elements work well, except at the top (respectively bottom).
In our constructions, these will be fixed and called $b$ and $a$.›

text ‹Notations for the next and the previous elements.›

definition next_in::"'a set  'a  ('a::linorder)"
  where "next_in A u = Min (A  {u<..})"

definition prev_in::"'a set  'a  ('a::linorder)"
  where "prev_in A u = Max (A  {..<u})"

context
  fixes A::"('a::linorder) set" and a b::'a
  assumes A: "finite A" "A  {a..b}" "a  A" "b  A" "a < b"
begin

text ‹Basic properties of the next element, when one starts from an element different from top.›

lemma next_in_basics:
  assumes "u  {a..<b}"
  shows "next_in A u  A"
        "next_in A u > u"
        "A  {u<..<next_in A u} = {}"
proof -
  have next_in_A: "next_in A u  A  {u<..}"
    unfolding next_in_def apply (rule Min_in)
    using assms ‹finite A b  A by auto
  then show "next_in A u  A" "next_in A u > u" by auto
  show "A  {u<..<next_in A u} = {}"
    unfolding next_in_def using A by (auto simp add: leD)
qed

lemma next_inI:
  assumes "u  {a..<b}"
          "v  A"
          "v > u"
          "{u<..<v}  A = {}"
  shows "next_in A u = v"
using assms next_in_basics[OF u  {a..<b}] by fastforce

text ‹Basic properties of the previous element, when one starts from an element different from
bottom.›

lemma prev_in_basics:
  assumes "u  {a<..b}"
  shows "prev_in A u  A"
        "prev_in A u < u"
        "A  {prev_in A u<..<u} = {}"
proof -
  have prev_in_A: "prev_in A u  A  {..<u}"
    unfolding prev_in_def apply (rule Max_in)
    using assms ‹finite A a  A by auto
  then show "prev_in A u  A" "prev_in A u < u" by auto
  show "A  {prev_in A u<..<u} = {}"
    unfolding prev_in_def using A by (auto simp add: leD)
qed

lemma prev_inI:
  assumes "u  {a<..b}"
          "v  A"
          "v < u"
          "{v<..<u}  A = {}"
  shows "prev_in A u = v"
using assms prev_in_basics[OF u  {a<..b}]
by (meson disjoint_iff_not_equal greaterThanLessThan_iff less_linear)

text ‹The interval $[a,b]$ is covered by the intervals between the consecutive elements of $A$.›

lemma intervals_decomposition:
  "( U  {{u..next_in A u} | u. u  A - {b}}. U) = {a..b}"
proof
  show "(U{{u..next_in A u} |u. u  A - {b}}. U)  {a..b}"
    using A  {a..b} next_in_basics(1) apply auto apply fastforce
    by (metis A  {a..b} atLeastAtMost_iff eq_iff le_less_trans less_eq_real_def not_less subset_eq subset_iff_psubset_eq)

  have "x  (U{{u..next_in A u} |u. u  A - {b}}. U)" if "x  {a..b}" for x
  proof -
    consider "x = b" | "x  A - {b}" | "x  A" by blast
    then show ?thesis
    proof(cases)
      case 1
      define u where "u = prev_in A b"
      have "b  {a<..b}" using a < b by simp
      have "u  A - {b}" unfolding u_def using prev_in_basics[OF b  {a<..b}] by simp
      then have "u  {a..<b}" using A  {a..b} a < b by fastforce
      have "next_in A u = b"
        using prev_in_basics[OF b  {a<..b}] next_in_basics[OF u  {a..<b}] A  {a..b} unfolding u_def by force
      then have "x  {u..next_in A u}" unfolding 1 using prev_in_basics[OF b  {a<..b}] u_def by auto
      then show ?thesis using u  A - {b} by auto
    next
      case 2
      then have "x  {a..<b}" using A  {a..b} a < b by fastforce
      have "x  {x.. next_in A x}" using next_in_basics[OF x  {a..<b}] by auto
      then show ?thesis using 2 by auto
    next
      case 3
      then have "x  {a<..b}" using that a  A leI by fastforce
      define u where "u = prev_in A x"
      have "u  A - {b}" unfolding u_def using prev_in_basics[OF x  {a<..b}] that by auto
      then have "u  {a..<b}" using A  {a..b} a < b by fastforce
      have "x  {u..next_in A u}"
        using prev_in_basics[OF x  {a<..b}] next_in_basics[OF u  {a..<b}] unfolding u_def by auto
      then show ?thesis using u  A - {b} by auto
    qed
  qed
  then show "{a..b}  (U{{u..next_in A u} |u. u  A - {b}}. U)" by auto
qed
end

text ‹If one inserts an additional element, then next and previous elements are not modified,
except at the location of the insertion.›

lemma next_in_insert:
  assumes A: "finite A" "A  {a..b}" "a  A" "b  A" "a < b"
      and "x  {a..b} - A"
  shows "u. u  A - {b, prev_in A x}  next_in (insert x A) u = next_in A u"
        "next_in (insert x A) x = next_in A x"
        "next_in (insert x A) (prev_in A x) = x"
proof -
  define B where "B = insert x A"
  have B: "finite B" "B  {a..b}" "a  B" "b  B" "a < b"
    using assms unfolding B_def by auto
  have x: "x  {a..<b}" "x  {a<..b}" using assms leI by fastforce+
  show "next_in B x = next_in A x"
    unfolding B_def by (auto simp add: next_in_def)

  show "next_in B (prev_in A x) = x"
    apply (rule next_inI[OF B])
    unfolding B_def using prev_in_basics[OF A x  {a<..b}] A  {a..b} x by auto

  fix u assume "u  A - {b, prev_in A x}"
  then have "u  {a..<b}" using assms by fastforce
  have "x  {u<..<next_in A u}"
  proof (rule ccontr)
    assume "¬(x  {u<..<next_in A u})"
    then have *: "x  {u<..<next_in A u}" by auto
    have "prev_in A x = u"
      apply (rule prev_inI[OF A x  {a<..b}])
      using u  A - {b, prev_in A x} * next_in_basics[OF A u  {a..<b}] apply auto
      by (meson disjoint_iff_not_equal greaterThanLessThan_iff less_trans)
    then show False using u  A - {b, prev_in A x} by auto
  qed
  show "next_in B u = next_in A u"
    apply (rule next_inI[OF B u  {a..<b}]) unfolding B_def
    using next_in_basics[OF A u  {a..<b}] x  {u<..<next_in A u} by auto
qed

text ‹If consecutive elements are enough separated, this implies a simple bound on the
cardinality of the set.›

lemma separated_in_real_card_bound2:
  fixes A::"real set"
  assumes A: "finite A" "A  {a..b}" "a  A" "b  A" "a < b"
      and B: "u. u  A - {b}  next_in A u  u + d" "d > 0"
  shows "card A  nat (floor ((b-a)/d) + 1)"
proof (rule separated_in_real_card_bound[OF A  {a..b} d > 0])
  fix x y assume "x  A" "y  A" "y > x"
  then have "x  A - {b}" "x  {a..<b}" using A  {a..b} by auto
  have "y  next_in A x"
    using next_in_basics[OF A x  {a..<b}] y  A y > x by auto
  then show "y  x + d" using B(1)[OF x  A - {b}] by auto
qed


subsection ‹Well-orders›

text ‹In this subsection, we give additional lemmas on well-orders or cardinals or whatever,
that would well belong to the library, and will be needed below.›

lemma (in wo_rel) max2_underS [simp]:
  assumes "x  underS z" "y  underS z"
  shows "max2 x y  underS z"
using assms max2_def by auto

lemma (in wo_rel) max2_underS' [simp]:
  assumes "x  underS y"
  shows "max2 x y = y" "max2 y x = y"
apply (simp add: underS_E assms max2_def)
using assms max2_def ANTISYM antisym_def underS_E by fastforce

lemma (in wo_rel) max2_xx [simp]:
  "max2 x x = x"
using max2_def by auto

declare underS_notIn [simp]

text ‹The abbrevation $=o$ is used both in \verb+Set_Algebras+ and Cardinals.
We disable the one from \verb+Set_Algebras+.›

no_notation elt_set_eq (infix "=o" 50)

lemma regularCard_ordIso:
  assumes "Card_order r" "regularCard r" "s =o r"
  shows "regularCard s"
unfolding regularCard_def
proof (auto)
  fix K assume K: "K  Field s" "cofinal K s"
  obtain f where f: "bij_betw f (Field s) (Field r)" "embed s r f" using s =o r unfolding ordIso_def iso_def by auto
  have "f`K  Field r" using K(1) f(1) bij_betw_imp_surj_on by blast
  have "cofinal (f`K) r" unfolding cofinal_def
  proof
    fix a assume "a  Field r"
    then obtain a' where a: "a'  Field s" "f a' = a" using f
      by (metis bij_betw_imp_surj_on imageE)
    then obtain b' where b: "b'  K" "a'  b'  (a', b')  s"
      using ‹cofinal K s unfolding cofinal_def by auto
    have P1: "f b'  f`K" using b(1) by auto
    have "a'  b'" "a'  Field s" "b'  Field s" using a(1) b K(1) by auto
    then have P2: "a  f b'" unfolding a(2)[symmetric] using f(1) unfolding bij_betw_def inj_on_def by auto
    have "(a', b')  s" using b by auto
    then have P3: "(a, f b')  r" unfolding a(2)[symmetric] using f
      by (meson FieldI1 FieldI2 Card_order_ordIso[OF assms(1) assms(3)] card_order_on_def iso_defs(1) iso_iff2)
    show "bf ` K. a  b  (a, b)  r"
      using P1 P2 P3 by blast
  qed
  then have "|f`K| =o r"
    using ‹regularCard r f`K  Field r unfolding regularCard_def by auto
  moreover have "|f`K| =o |K|" using f(1) K(1)
    by (meson bij_betw_subset card_of_ordIsoI ordIso_symmetric)
  ultimately show "|K| =o s"
    using s =o r by (meson ordIso_symmetric ordIso_transitive)
qed

lemma AboveS_not_empty_in_regularCard:
  assumes "|S| <o r" "S  Field r"
  assumes r: "Card_order r" "regularCard r" "¬finite (Field r)"
  shows "AboveS r S  {}"
proof -
  have "¬(cofinal S r)"
    using assms not_ordLess_ordIso unfolding regularCard_def by auto
  then obtain a where a: "a  Field r" "bS. ¬(a  b  (a,b)  r)"
    unfolding cofinal_def by auto
  have *: "a = b  (b, a)  r" if "b  S" for b
  proof -
    have "a = b  (a,b)  r" using a that by auto
    then show ?thesis
      using ‹Card_order r a  Field r b  S S  Field r unfolding card_order_on_def well_order_on_def linear_order_on_def total_on_def
      by auto
  qed
  obtain c where "c  Field r" "c  a" "(a, c)  r"
    using a(1) r infinite_Card_order_limit by fastforce
  then have "c  AboveS r S"
    unfolding AboveS_def apply simp using Card_order_trans[OF r(1)] by (metis *)
  then show ?thesis by auto
qed

lemma AboveS_not_empty_in_regularCard':
  assumes "|S| <o r" "f`S  Field r" "T  S"
  assumes r: "Card_order r" "regularCard r" "¬finite (Field r)"
  shows "AboveS r (f`T)  {}"
proof -
  have "|f`T| ≤o |T|" by simp
  moreover have "|T| ≤o |S|" using T  S by simp
  ultimately have *: "|f`T| <o r" using |S| <o r by (meson ordLeq_ordLess_trans)
  show ?thesis using AboveS_not_empty_in_regularCard[OF * _ r] T  S f`S  Field r by auto
qed

lemma Well_order_extend:
assumes WELL: "well_order_on A r" and SUB: "A  B"
shows "r'. well_order_on B r'  r  r'"
proof-
  have r: "Well_order r  Field r = A" using WELL well_order_on_Well_order by blast
  let ?C = "B - A"
  obtain r'' where "well_order_on ?C r''" using well_order_on by blast
  then have r'': "Well_order r''  Field r'' = ?C"
    using well_order_on_Well_order by blast
  let ?r' = "r Osum r''"
  have "Field r Int Field r'' = {}" using r r'' by auto
  then have "r ≤o ?r'" using Osum_ordLeq[of r r''] r r'' by blast
  then have "Well_order ?r'" unfolding ordLeq_def by auto
  moreover have "Field ?r' = B" using r r'' SUB by (auto simp add: Field_Osum)
  ultimately have "well_order_on B ?r'" by auto
  moreover have "r  ?r'" by (simp add: Osum_def subrelI)
  ultimately show ?thesis by blast
qed

text ‹The next lemma shows that, if the range of a function is endowed with a wellorder,
then one can pull back this wellorder by the function, and then extend it in the fibers
of the function in order to keep the wellorder property.

The proof is done by taking an arbitrary family of wellorders on each of the fibers, and using
the lexicographic order: one has $x < y$ if $f x < f y$, or if $f x = f y$ and, in the corresponding
fiber of $f$, one has $x < y$.

To formalize it, it is however more efficient to use one single wellorder, and restrict it
to each fiber.›

lemma Well_order_pullback:
  assumes "Well_order r"
  shows "s. Well_order s  Field s = UNIV  (x y. (f x, f y)  (r-Id)  (x, y)  s)"
proof -
  obtain r2 where r2: "Well_order r2" "Field r2 = UNIV" "r  r2"
    using Well_order_extend[OF assms, of UNIV] well_order_on_Well_order by auto
  obtain s2 where s2: "Well_order s2" "Field s2 = (UNIV::'b set)"
    by (meson well_ordering)

  have r2s2:
    "x y z. (x, y)  s2  (y, z)  s2  (x, z)  s2"
    "x. (x, x)  s2"
    "x y. (x, y)  s2  (y, x)  s2"
    "x y. (x, y)  s2  (y, x)  s2  x = y"
    "x y z. (x, y)  r2  (y, z)  r2  (x, z)  r2"
    "x. (x, x)  r2"
    "x y. (x, y)  r2  (y, x)  r2"
    "x y. (x, y)  r2  (y, x)  r2  x = y"
    using r2 s2 unfolding well_order_on_def linear_order_on_def partial_order_on_def total_on_def preorder_on_def antisym_def refl_on_def trans_def
    by (metis UNIV_I)+

  define s where "s = {(x,y). (f x, f y)  r2  (f x = f y  (x, y)  s2)}"
  have "linear_order s"
  unfolding linear_order_on_def partial_order_on_def preorder_on_def
  proof (auto)
    show "total_on UNIV s"
      unfolding s_def apply (rule total_onI, auto) using r2s2 by metis+
    show "refl_on UNIV s"
      unfolding s_def apply (rule refl_onI, auto) using r2s2 by blast+
    show "trans s"
      unfolding s_def apply (rule transI, auto) using r2s2 by metis+
    show "antisym s"
      unfolding s_def apply (rule antisymI, auto) using r2s2 by metis+
  qed
  moreover have "wf (s - Id)"
  proof (rule wfI_min)
    fix x::'b and Q assume "x  Q"
    obtain z' where z': "z'  f`Q" "y. (y, z')  r2 - Id  y  f`Q"
    proof (rule wfE_min[of "r2-Id" "f x" "f`Q"], auto)
      show "wf(r2-Id)" using ‹Well_order r2 unfolding well_order_on_def by auto
      show "f x  f`Q" using x  Q by auto
    qed
    define Q2 where "Q2 = Q  f-`{z'}"
    obtain z where z: "z  Q2" "y. (y, z)  s2 - Id  y  Q2"
    proof (rule wfE_min'[of "s2-Id" "Q2"], auto)
      show "wf(s2-Id)" using ‹Well_order s2 unfolding well_order_on_def by auto
      assume "Q2 = {}"
      then show False unfolding Q2_def using z'  f`Q by blast
    qed
    have "(y, z)  (s-Id)  y  Q" for y
      unfolding s_def using z' z Q2_def by auto
    then show "zQ. y. (y, z)  s - Id  y  Q"
      using z  Q2 Q2_def by auto
  qed
  ultimately have "well_order_on UNIV s" unfolding well_order_on_def by simp
  moreover have "(f x, f y)  (r-Id)  (x, y)  s" for x y
    unfolding s_def using r  r2 by auto
  ultimately show ?thesis using well_order_on_Well_order by metis
qed

end (*of theory Library_Complements*)

Theory Eexp_Eln

(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
    License: BSD
*)

section ‹The exponential on extended real numbers.›

theory Eexp_Eln
  imports Library_Complements
begin

text ‹To define the distance on the Gromov completion of hyperbolic spaces, we need to use
the exponential on extended real numbers. We can not use the symbol \verb+exp+, as this symbol
is already used in Banach algebras, so we use \verb+ennexp+ instead. We prove its basic
properties (together with properties of the logarithm) here. We also use it to define the square
root on ennreal. Finally, we also define versions from ereal to ereal.›

function ennexp::"ereal  ennreal" where
"ennexp (ereal r) = ennreal (exp r)"
| "ennexp () = "
| "ennexp (-) = 0"
by (auto intro: ereal_cases)
termination by standard (rule wf_empty)

lemma ennexp_0 [simp]:
  "ennexp 0 = 1"
by (auto simp add: zero_ereal_def one_ennreal_def)

function eln::"ennreal  ereal" where
"eln (ennreal r) = (if r  0 then - else ereal (ln r))"
| "eln () = "
by (auto intro: ennreal_cases, metis ennreal_eq_0_iff, simp add: ennreal_neg)
termination by standard (rule wf_empty)

lemma eln_simps [simp]:
  "eln 0 = -"
  "eln 1 = 0"
  "eln top = "
apply (simp only: eln.simps ennreal_0[symmetric], simp)
apply (simp only: eln.simps ennreal_1[symmetric], simp)
using eln.simps(2) by auto

lemma eln_real_pos:
  assumes "r > 0"
  shows "eln (ennreal r) = ereal (ln r)"
using eln.simps assms by auto

lemma eln_ennexp [simp]:
  "eln (ennexp x) = x"
apply (cases x) using eln.simps by auto

lemma ennexp_eln [simp]:
  "ennexp (eln x) = x"
apply (cases x) using eln.simps by auto

lemma ennexp_strict_mono:
  "strict_mono ennexp"
proof -
  have "ennexp x < ennexp y" if "x < y" for x y
    apply (cases x, cases y)
    using that apply (auto simp add: ennreal_less_iff)
    by (cases y, auto)
  then show ?thesis unfolding strict_mono_def by auto
qed

lemma ennexp_mono:
  "mono ennexp"
using ennexp_strict_mono by (simp add: strict_mono_mono)

lemma ennexp_strict_mono2 [mono_intros]:
  assumes "x < y"
  shows "ennexp x < ennexp y"
using ennexp_strict_mono assms unfolding strict_mono_def by auto

lemma ennexp_mono2 [mono_intros]:
  assumes "x  y"
  shows "ennexp x  ennexp y"
using ennexp_mono assms unfolding mono_def by auto

lemma ennexp_le1 [simp]:
  "ennexp x  1  x  0"
by (metis ennexp_0 ennexp_mono2 ennexp_strict_mono eq_iff le_cases strict_mono_eq)

lemma ennexp_ge1 [simp]:
  "ennexp x  1  x  0"
by (metis ennexp_0 ennexp_mono2 ennexp_strict_mono eq_iff le_cases strict_mono_eq)

lemma eln_strict_mono:
  "strict_mono eln"
by (metis ennexp_eln strict_monoI ennexp_strict_mono strict_mono_less)

lemma eln_mono:
  "mono eln"
using eln_strict_mono by (simp add: strict_mono_mono)

lemma eln_strict_mono2 [mono_intros]:
  assumes "x < y"
  shows "eln x < eln y"
using eln_strict_mono assms unfolding strict_mono_def by auto

lemma eln_mono2 [mono_intros]:
  assumes "x  y"
  shows "eln x  eln y"
using eln_mono assms unfolding mono_def by auto

lemma eln_le0 [simp]:
  "eln x  0  x  1"
by (metis ennexp_eln ennexp_le1)

lemma eln_ge0 [simp]:
  "eln x  0  x  1"
by (metis ennexp_eln ennexp_ge1)

lemma bij_ennexp:
  "bij ennexp"
by (auto intro!: bij_betw_byWitness[of _ eln])

lemma bij_eln:
  "bij eln"
by (auto intro!: bij_betw_byWitness[of _ ennexp])

lemma ennexp_continuous:
  "continuous_on UNIV ennexp"
apply (rule continuous_onI_mono)
using ennexp_mono unfolding mono_def by (auto simp add: bij_ennexp bij_is_surj)

lemma ennexp_tendsto [tendsto_intros]:
  assumes "((λn. u n)  l) F"
  shows "((λn. ennexp(u n))  ennexp l) F"
using ennexp_continuous assms by (metis UNIV_I continuous_on tendsto_compose)

lemma eln_continuous:
  "continuous_on UNIV eln"
apply (rule continuous_onI_mono)
using eln_mono unfolding mono_def by (auto simp add: bij_eln bij_is_surj)

lemma eln_tendsto [tendsto_intros]:
  assumes "((λn. u n)  l) F"
  shows "((λn. eln(u n))  eln l) F"
using eln_continuous assms by (metis UNIV_I continuous_on tendsto_compose)

lemma ennexp_special_values [simp]:
  "ennexp x = 0  x = -"
  "ennexp x = 1  x = 0"
  "ennexp x =   x = "
  "ennexp x = top  x = "
by auto (metis eln_ennexp eln_simps)+

lemma eln_special_values [simp]:
  "eln x = -  x = 0"
  "eln x = 0  x = 1"
  "eln x =   x = "
apply auto
apply (metis ennexp.simps ennexp_eln ennexp_0)+
by (metis ennexp.simps(2) ennexp_eln infinity_ennreal_def)

lemma ennexp_add_mult:
  assumes "¬((a =   b = -)  (a = -  b = ))"
  shows "ennexp(a+b) = ennexp a * ennexp b"
apply (cases a, cases b)
using assms by (auto simp add: ennreal_mult'' exp_add ennreal_top_eq_mult_iff)

lemma eln_mult_add:
  assumes "¬((a =   b = 0)  (a = 0  b = ))"
  shows "eln(a * b) = eln a + eln b"
by (smt assms ennexp.simps(2) ennexp.simps(3) ennexp_add_mult ennexp_eln eln_ennexp)

text ‹We can also define the square root on ennreal using the above exponential.›

definition ennsqrt::"ennreal  ennreal"
  where "ennsqrt x = ennexp(eln x/2)"

lemma ennsqrt_square [simp]:
  "(ennsqrt x) * (ennsqrt x) = x"
proof -
  have "y/2 + y/2 = y" for y::ereal
    by (cases y, auto)
  then show ?thesis
    unfolding ennsqrt_def by (subst ennexp_add_mult[symmetric], auto)
qed

lemma ennsqrt_simps [simp]:
  "ennsqrt 0 = 0"
  "ennsqrt 1 = 1"
  "ennsqrt  = "
  "ennsqrt top = top"
unfolding ennsqrt_def by auto

lemma ennsqrt_mult:
  "ennsqrt(a * b) = ennsqrt a * ennsqrt b"
proof -
  have [simp]: "z/ereal 2 = -  z = -" for z
    by (auto simp add: ereal_divide_eq)

  consider "a = 0" | "b = 0" | "a > 0  b > 0"
    using zero_less_iff_neq_zero by auto
  then show ?thesis
    apply (cases, auto)
    apply (cases a, cases b, auto simp add: ennreal_mult_top ennreal_top_mult)
    unfolding ennsqrt_def apply (subst ennexp_add_mult[symmetric], auto)
    apply (subst eln_mult_add, auto)
    done
qed

lemma ennsqrt_square2 [simp]:
  "ennsqrt (x * x) = x"
  unfolding ennsqrt_mult by auto

lemma ennsqrt_eq_iff_square:
  "ennsqrt x = y  x = y * y"
by auto

lemma ennsqrt_bij:
  "bij ennsqrt"
by (rule bij_betw_byWitness[of _ "λx. x * x"], auto)

lemma ennsqrt_strict_mono:
  "strict_mono ennsqrt"
  unfolding ennsqrt_def
  apply (rule strict_mono_compose[OF ennexp_strict_mono])
  apply (rule strict_mono_compose[OF _ eln_strict_mono])
  by (auto simp add: ereal_less_divide_pos ereal_mult_divide strict_mono_def)

lemma ennsqrt_mono:
  "mono ennsqrt"
using ennsqrt_strict_mono by (simp add: strict_mono_mono)

lemma ennsqrt_mono2 [mono_intros]:
  assumes "x  y"
  shows "ennsqrt x  ennsqrt y"
using ennsqrt_mono assms unfolding mono_def by auto

lemma ennsqrt_continuous:
  "continuous_on UNIV ennsqrt"
apply (rule continuous_onI_mono)
using ennsqrt_mono unfolding mono_def by (auto simp add: ennsqrt_bij bij_is_surj)

lemma ennsqrt_tendsto [tendsto_intros]:
  assumes "((λn. u n)  l) F"
  shows "((λn. ennsqrt(u n))  ennsqrt l) F"
using ennsqrt_continuous assms by (metis UNIV_I continuous_on tendsto_compose)

lemma ennsqrt_ennreal_ennreal_sqrt [simp]:
  assumes "t  (0::real)"
  shows "ennsqrt (ennreal t) = ennreal (sqrt t)"
proof -
  have "ennreal t = ennreal (sqrt t) * ennreal(sqrt t)"
    apply (subst ennreal_mult[symmetric]) using assms by auto
  then show ?thesis
    by auto
qed

lemma ennreal_sqrt2:
  "ennreal (sqrt 2) = ennsqrt 2"
using ennsqrt_ennreal_ennreal_sqrt[of 2] by auto

lemma ennsqrt_4 [simp]:
  "ennsqrt 4 = 2"
by (metis ennreal_numeral ennsqrt_ennreal_ennreal_sqrt real_sqrt_four zero_le_numeral)

lemma ennsqrt_le [simp]:
  "ennsqrt x  ennsqrt y  x  y"
proof
  assume "ennsqrt x  ennsqrt y"
  then have "ennsqrt x * ennsqrt x  ennsqrt y * ennsqrt y"
    by (intro mult_mono, auto)
  then show "x  y" by auto
qed (auto intro: mono_intros)

text ‹We can also define the square root on ereal using the square root on ennreal, and $0$
for negative numbers.›

definition esqrt::"ereal  ereal"
  where "esqrt x = enn2ereal(ennsqrt (e2ennreal x))"

lemma esqrt_square [simp]:
  assumes "x  0"
  shows "(esqrt x) * (esqrt x) = x"
unfolding esqrt_def times_ennreal.rep_eq[symmetric] ennsqrt_square[of "e2ennreal x"]
using assms enn2ereal_e2ennreal by auto

lemma esqrt_of_neg [simp]:
  assumes "x  0"
  shows "esqrt x = 0"
  unfolding esqrt_def e2ennreal_neg[OF assms] by (auto simp add: zero_ennreal.rep_eq)

lemma esqrt_nonneg [simp]:
  "esqrt x  0"
unfolding esqrt_def by auto

lemma esqrt_eq_iff_square [simp]:
  assumes "x  0" "y  0"
  shows "esqrt x = y  x = y * y"
using esqrt_def esqrt_square assms apply auto
by (metis e2ennreal_enn2ereal ennsqrt_square2 eq_onp_same_args ereal_ennreal_cases leD times_ennreal.abs_eq)

lemma esqrt_simps [simp]:
  "esqrt 0 = 0"
  "esqrt 1 = 1"
  "esqrt  = "
  "esqrt top = top"
  "esqrt (-) = 0"
by (auto simp: top_ereal_def)

lemma esqrt_mult:
  assumes "a  0"
  shows "esqrt(a * b) = esqrt a * esqrt b"
proof (cases "b  0")
  case True
  show ?thesis
    unfolding esqrt_def apply (subst times_ennreal.rep_eq[symmetric])
    apply (subst ennsqrt_mult[of "e2ennreal a" "e2ennreal b", symmetric])
    apply (subst times_ennreal.abs_eq)
    using assms True by (auto simp add: eq_onp_same_args)
next
  case False
  then have "a * b  0" using assms ereal_mult_le_0_iff by auto
  then have "esqrt(a * b) = 0" by auto
  moreover have "esqrt b = 0" using False by auto
  ultimately show ?thesis by auto
qed

lemma esqrt_square2 [simp]:
  "esqrt(x * x) = abs(x)"
proof -
  have "esqrt(x * x) = esqrt(abs x * abs x)"
    by (metis (no_types, hide_lams) abs_ereal_ge0 ereal_abs_mult ereal_zero_le_0_iff linear)
  also have "... = abs x"
    by (auto simp add: esqrt_mult)
  finally show ?thesis by auto
qed

lemma esqrt_mono:
  "mono esqrt"
unfolding esqrt_def mono_def by (auto intro: mono_intros)

lemma esqrt_mono2 [mono_intros]:
  assumes "x  y"
  shows "esqrt x  esqrt y"
using esqrt_mono assms unfolding mono_def by auto

lemma esqrt_continuous:
  "continuous_on UNIV esqrt"
unfolding esqrt_def apply (rule continuous_on_compose2[of UNIV enn2ereal], intro continuous_on_enn2ereal)
by (rule continuous_on_compose2[of UNIV ennsqrt], auto intro!: ennsqrt_continuous continuous_on_e2ennreal)

lemma esqrt_tendsto [tendsto_intros]:
  assumes "((λn. u n)  l) F"
  shows "((λn. esqrt(u n))  esqrt l) F"
using esqrt_continuous assms by (metis UNIV_I continuous_on tendsto_compose)

lemma esqrt_ereal_ereal_sqrt [simp]:
  assumes "t  (0::real)"
  shows "esqrt (ereal t) = ereal (sqrt t)"
proof -
  have "ereal t = ereal (sqrt t) * ereal(sqrt t)"
    using assms by auto
  then show ?thesis
    using assms ereal_less_eq(5) esqrt_mult esqrt_square real_sqrt_ge_zero by presburger
qed

lemma ereal_sqrt2:
  "ereal (sqrt 2) = esqrt 2"
using esqrt_ereal_ereal_sqrt[of 2] by auto

lemma esqrt_4 [simp]:
  "esqrt 4 = 2"
by auto

lemma esqrt_le [simp]:
  "esqrt x  esqrt y  (x  0  x  y)"
apply (auto simp add: esqrt_mono2)
by (metis eq_iff ereal_zero_times esqrt_mono2 esqrt_square le_cases)

text ‹Finally, we define eexp, as the composition of ennexp and the injection of ennreal in ereal.›

definition eexp::"ereal  ereal" where
  "eexp x = enn2ereal (ennexp x)"

lemma eexp_special_values [simp]:
  "eexp 0 = 1"
  "eexp () = "
  "eexp(-) = 0"
unfolding eexp_def by (auto simp add: zero_ennreal.rep_eq one_ennreal.rep_eq)

lemma eexp_strict_mono:
  "strict_mono eexp"
unfolding eexp_def using ennexp_strict_mono unfolding strict_mono_def by (auto intro: mono_intros)

lemma eexp_mono:
  "mono eexp"
using eexp_strict_mono by (simp add: strict_mono_mono)

lemma eexp_strict_mono2 [mono_intros]:
  assumes "x < y"
  shows "eexp x < eexp y"
using eexp_strict_mono assms unfolding strict_mono_def by auto

lemma eexp_mono2 [mono_intros]:
  assumes "x  y"
  shows "eexp x  eexp y"
using eexp_mono assms unfolding mono_def by auto

lemma eexp_le_eexp_iff_le:
  "eexp x  eexp y  x  y"
using eexp_strict_mono2 not_le by (auto intro: mono_intros)

lemma eexp_lt_eexp_iff_lt:
  "eexp x < eexp y  x < y"
using eexp_mono2 not_le by (auto intro: mono_intros)

lemma eexp_special_values_iff [simp]:
  "eexp x = 0  x = -"
  "eexp x = 1  x = 0"
  "eexp x =   x = "
  "eexp x = top  x = "
unfolding eexp_def apply (auto simp add: zero_ennreal.rep_eq one_ennreal.rep_eq top_ereal_def)
apply (metis e2ennreal_enn2ereal ennexp.simps(3) ennexp_strict_mono strict_mono_eq zero_ennreal_def)
by (metis e2ennreal_enn2ereal eln_ennexp eln_simps(2) one_ennreal_def)

lemma eexp_ineq_iff [simp]:
  "eexp x  1  x  0"
  "eexp x  1  x  0"
  "eexp x > 1  x > 0"
  "eexp x < 1  x < 0"
  "eexp x  0"
  "eexp x > 0  x  - "
  "eexp x <   x  "
apply (metis eexp_le_eexp_iff_le eexp_lt_eexp_iff_lt eexp_special_values)+
apply (simp add: eexp_def)
using eexp_strict_mono2 apply (force)
by simp

lemma eexp_ineq [mono_intros]:
  "x  0  eexp x  1"
  "x < 0  eexp x < 1"
  "x  0  eexp x  1"
  "x > 0  eexp x > 1"
  "eexp x  0"
  "x > -  eexp x > 0"
  "x <   eexp x < "
by auto

lemma eexp_continuous:
  "continuous_on UNIV eexp"
unfolding eexp_def by (rule continuous_on_compose2[of UNIV enn2ereal], auto simp: continuous_on_enn2ereal ennexp_continuous)


lemma eexp_tendsto' [simp]:
  "((λn. eexp(u n))  eexp l) F  ((λn. u n)  l) F"
proof
  assume H: "((λn. eexp (u n))  eexp l) F"
  have "((λn. eln (e2ennreal (eexp (u n))))  eln (e2ennreal (eexp l))) F"
    by (intro tendsto_intros H)
  then show "(u  l) F"
    unfolding eexp_def by auto
next
  assume "(u  l) F"
  then show "((λn. eexp(u n))  eexp l) F"
    using eexp_continuous by (metis UNIV_I continuous_on tendsto_compose)
qed

lemma eexp_tendsto [tendsto_intros]:
  assumes "((λn. u n)  l) F"
  shows "((λn. eexp(u n))  eexp l) F"
using assms by auto

lemma eexp_add_mult:
  assumes "¬((a =   b = -)  (a = -  b = ))"
  shows "eexp(a+b) = eexp a * eexp b"
using ennexp_add_mult[OF assms] unfolding eexp_def by (simp add: times_ennreal.rep_eq)

lemma eexp_ereal [simp]:
  "eexp(ereal x) = ereal(exp x)"
by (simp add: eexp_def)

end (*of theory Eexp_Eln*)

Theory Hausdorff_Distance

(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
    License: BSD
*)

section ‹Hausdorff distance›

theory Hausdorff_Distance
  imports Library_Complements
begin

subsection ‹Preliminaries›



subsection ‹Hausdorff distance›

text ‹The Hausdorff distance between two subsets of a metric space is the minimal $M$ such that
each set is included in the $M$-neighborhood of the other. For nonempty bounded sets, it
satisfies the triangular inequality, it is symmetric, but it vanishes on sets that have the same
closure. In particular, it defines a distance on closed bounded nonempty sets. We establish
all these properties below.›

definition hausdorff_distance::"('a::metric_space) set  'a set  real"
  where "hausdorff_distance A B = (if A = {}  B = {}  (¬(bounded A))  (¬(bounded B)) then 0
                                   else max (SUP xA. infdist x B) (SUP xB. infdist x A))"

lemma hausdorff_distance_self [simp]:
  "hausdorff_distance A A = 0"
unfolding hausdorff_distance_def by auto

lemma hausdorff_distance_sym:
  "hausdorff_distance A B = hausdorff_distance B A"
unfolding hausdorff_distance_def by auto

lemma hausdorff_distance_points [simp]:
  "hausdorff_distance {x} {y} = dist x y"
unfolding hausdorff_distance_def by (auto, metis dist_commute max.idem)

text ‹The Hausdorff distance is expressed in terms of a supremum. To use it, one needs again
and again to show that this is the supremum of a set which is bounded from above.›

lemma bdd_above_infdist_aux:
  assumes "bounded A" "bounded B"
  shows "bdd_above ((λx. infdist x B)`A)"
proof (cases "B = {}")
  case True
  then show ?thesis unfolding infdist_def by auto
next
  case False
  then obtain y where "y  B" by auto
  then have "infdist x B  dist x y" if "x  A" for x
    by (simp add: infdist_le)
  then show ?thesis unfolding bdd_above_def
    by (auto, metis assms(1) bounded_any_center dist_commute order_trans)
qed

lemma hausdorff_distance_nonneg [simp, mono_intros]:
  "hausdorff_distance A B  0"
proof (cases "A = {}  B = {}  (¬(bounded A))  (¬(bounded B))")
  case True
  then show ?thesis unfolding hausdorff_distance_def by auto
next
  case False
  then have "A  {}" "B  {}" "bounded A" "bounded B" by auto
  have "(SUP xA. infdist x B)  0"
    using bdd_above_infdist_aux[OF ‹bounded A ‹bounded B] infdist_nonneg
    by (metis A  {} all_not_in_conv cSUP_upper2)
  moreover have "(SUP xB. infdist x A)  0"
    using bdd_above_infdist_aux[OF ‹bounded B ‹bounded A] infdist_nonneg
    by (metis B  {} all_not_in_conv cSUP_upper2)
  ultimately show ?thesis unfolding hausdorff_distance_def by auto
qed

lemma hausdorff_distanceI:
  assumes "x. x  A  infdist x B  D"
          "x. x  B  infdist x A  D"
          "D  0"
  shows "hausdorff_distance A B  D"
proof (cases "A = {}  B = {}  (¬(bounded A))  (¬(bounded B))")
  case True
  then show ?thesis unfolding hausdorff_distance_def using D  0 by auto
next
  case False
  then have "A  {}" "B  {}" "bounded A" "bounded B" by auto
  have "(SUP xA. infdist x B)  D"
    apply (rule cSUP_least, simp add: A  {}) using assms(1) by blast
  moreover have "(SUP xB. infdist x A)  D"
    apply (rule cSUP_least, simp add: B  {}) using assms(2) by blast
  ultimately show ?thesis unfolding hausdorff_distance_def using False by auto
qed

lemma hausdorff_distanceI2:
  assumes "x. x  A  yB. dist x y  D"
          "x. x  B  yA. dist x y  D"
          "D  0"
  shows "hausdorff_distance A B  D"
proof (rule hausdorff_distanceI[OF _ _ D  0])
  fix x assume "x  A" show "infdist x B  D" using assms(1)[OF x  A] infdist_le2 by fastforce
next
  fix x assume "x  B" show "infdist x A  D" using assms(2)[OF x  B] infdist_le2 by fastforce
qed

lemma infdist_le_hausdorff_distance [mono_intros]:
  assumes "x  A" "bounded A" "bounded B"
  shows "infdist x B  hausdorff_distance A B"
proof (cases "B = {}")
  case True
  then have "infdist x B = 0" unfolding infdist_def by auto
  then show ?thesis using hausdorff_distance_nonneg by auto
next
  case False
  have "infdist x B  (SUP yA. infdist y B)"
    using bdd_above_infdist_aux[OF ‹bounded A ‹bounded B] by (meson assms(1) cSUP_upper)
  then show ?thesis unfolding hausdorff_distance_def using assms False by auto
qed

lemma hausdorff_distance_infdist_triangle [mono_intros]:
  assumes "B  {}" "bounded B" "bounded C"
  shows "infdist x C  infdist x B + hausdorff_distance B C"
proof (cases "C = {}")
  case True
  then have "infdist x C = 0" unfolding infdist_def by auto
  then show ?thesis using infdist_nonneg[of x B] hausdorff_distance_nonneg[of B C] by auto
next
  case False
  have "infdist x C - hausdorff_distance B C  dist x b" if "b  B" for b
  proof -
    have "infdist x C  infdist b C + dist x b" by (rule infdist_triangle)
    also have "...  dist x b + hausdorff_distance B C"
      using infdist_le_hausdorff_distance[OF b  B ‹bounded B ‹bounded C] by auto
    finally show ?thesis by auto
  qed
  then have "infdist x C - hausdorff_distance B C  infdist x B"
    unfolding infdist_def using B  {} by (simp add: le_cINF_iff)
  then show ?thesis by auto
qed

lemma hausdorff_distance_triangle [mono_intros]:
  assumes "B  {}" "bounded B"
  shows "hausdorff_distance A C  hausdorff_distance A B + hausdorff_distance B C"
proof (cases "A = {}  C = {}  (¬(bounded A))  (¬(bounded C))")
  case True
  then have "hausdorff_distance A C = 0" unfolding hausdorff_distance_def by auto
  then show ?thesis
    using hausdorff_distance_nonneg[of A B] hausdorff_distance_nonneg[of B C] by auto
next
  case False
  then have *: "A  {}" "C  {}" "bounded A" "bounded C" by auto
  define M where "M = hausdorff_distance A B + hausdorff_distance B C"
  have "infdist x C  M" if "x  A" for x
    using hausdorff_distance_infdist_triangle[OF B  {} ‹bounded B ‹bounded C, of x]
          infdist_le_hausdorff_distance[OF x  A ‹bounded A ‹bounded B] by (auto simp add: M_def)
  moreover have "infdist x A  M" if "x  C" for x
    using hausdorff_distance_infdist_triangle[OF B  {} ‹bounded B ‹bounded A, of x]
          infdist_le_hausdorff_distance[OF x  C ‹bounded C ‹bounded B]
    by (auto simp add: hausdorff_distance_sym M_def)
  ultimately have "hausdorff_distance A C  M"
    unfolding hausdorff_distance_def using * bdd_above_infdist_aux by (auto simp add: cSUP_least)
  then show ?thesis unfolding M_def by auto
qed

lemma hausdorff_distance_subset:
  assumes "A  B" "A  {}" "bounded B"
  shows "hausdorff_distance A B = (SUP xB. infdist x A)"
proof -
  have H: "B  {}" "bounded A" using assms bounded_subset by auto
  have "(SUP xA. infdist x B) = 0" using assms by (simp add: subset_eq)
  moreover have "(SUP xB. infdist x A)  0"
    using bdd_above_infdist_aux[OF ‹bounded B ‹bounded A] infdist_nonneg[of _ A]
    by (meson H(1) cSUP_upper2 ex_in_conv)
  ultimately show ?thesis unfolding hausdorff_distance_def using assms H by auto
qed

lemma hausdorff_distance_closure [simp]:
  "hausdorff_distance A (closure A) = 0"
proof (cases "A = {}  (¬(bounded A))")
  case True
  then show ?thesis unfolding hausdorff_distance_def by auto
next
  case False
  then have "A  {}" "bounded A" by auto
  then have "closure A  {}" "bounded (closure A)" "A  closure A"
    using closure_subset by auto
  have "infdist x A = 0" if "x  closure A" for x
    using in_closure_iff_infdist_zero[OF A  {}] that by auto
  then have "(SUP xclosure A. infdist x A) = 0"
    using ‹closure A  {} by auto
  then show ?thesis
    unfolding hausdorff_distance_subset[OF A  closure A A  {} ‹bounded (closure A)] by simp
qed

lemma hausdorff_distance_closures [simp]:
  "hausdorff_distance (closure A) (closure B) = hausdorff_distance A B"
proof (cases "A = {}  B = {}  (¬(bounded A))  (¬(bounded B))")
  case True
  then have *: "hausdorff_distance A B = 0" unfolding hausdorff_distance_def by auto
  have "closure A = {}  (¬(bounded (closure A)))  closure B = {}  (¬(bounded (closure B)))"
    using True bounded_subset closure_subset by auto
  then have "hausdorff_distance (closure A) (closure B) = 0"
    unfolding hausdorff_distance_def by auto
  then show ?thesis using * by simp
next
  case False
  then have H: "A  {}" "B  {}" "bounded A" "bounded B" by auto
  then have H2: "closure A  {}" "closure B  {}" "bounded (closure A)" "bounded (closure B)"
    by auto
  have "hausdorff_distance A B  hausdorff_distance A (closure A) + hausdorff_distance (closure A) B"
    apply (rule hausdorff_distance_triangle) using H H2 by auto
  also have "... = hausdorff_distance (closure A) B"
    using hausdorff_distance_closure by auto
  also have "...  hausdorff_distance (closure A) (closure B) + hausdorff_distance (closure B) B"
    apply (rule hausdorff_distance_triangle) using H H2 by auto
  also have "... = hausdorff_distance (closure A) (closure B)"
    using hausdorff_distance_closure by (auto simp add: hausdorff_distance_sym)
  finally have *: "hausdorff_distance A B  hausdorff_distance (closure A) (closure B)" by simp

  have "hausdorff_distance (closure A) (closure B)  hausdorff_distance (closure A) A + hausdorff_distance A (closure B)"
    apply (rule hausdorff_distance_triangle) using H H2 by auto
  also have "... = hausdorff_distance A (closure B)"
    using hausdorff_distance_closure by (auto simp add: hausdorff_distance_sym)
  also have "...  hausdorff_distance A B + hausdorff_distance B (closure B)"
    apply (rule hausdorff_distance_triangle) using H H2 by auto
  also have "... = hausdorff_distance A B"
    using hausdorff_distance_closure by (auto simp add: hausdorff_distance_sym)
  finally have "hausdorff_distance (closure A) (closure B)  hausdorff_distance A B" by simp
  then show ?thesis using * by auto
qed

lemma hausdorff_distance_zero:
  assumes "A  {}" "bounded A" "B  {}" "bounded B"
  shows "hausdorff_distance A B = 0  closure A = closure B"
proof
  assume H: "hausdorff_distance A B = 0"
  have "A  closure B"
  proof
    fix x assume "x  A"
    have "infdist x B = 0"
      using infdist_le_hausdorff_distance[OF x  A ‹bounded A ‹bounded B] H infdist_nonneg[of x B] by auto
    then show "x  closure B" using in_closure_iff_infdist_zero[OF B  {}] by auto
  qed
  then have A: "closure A  closure B" by (simp add: closure_minimal)

  have "B  closure A"
  proof
    fix x assume "x  B"
    have "infdist x A = 0"
      using infdist_le_hausdorff_distance[OF x  B ‹bounded B ‹bounded A] H infdist_nonneg[of x A]
      by (auto simp add: hausdorff_distance_sym)
    then show "x  closure A" using in_closure_iff_infdist_zero[OF A  {}] by auto
  qed
  then have "closure B  closure A" by (simp add: closure_minimal)
  then show "closure A = closure B" using A by auto
next
  assume "closure A = closure B"
  then show "hausdorff_distance A B = 0"
    using hausdorff_distance_closures[of A B] by auto
qed

lemma hausdorff_distance_vimage:
  assumes "x. x  A  dist (f x) (g x)  C"
          "C  0"
  shows "hausdorff_distance (f`A) (g`A)  C"
apply (rule hausdorff_distanceI2[OF _ _ C  0]) using assms by (auto simp add: dist_commute, auto)

lemma hausdorff_distance_union [mono_intros]:
  assumes "A  {}" "B  {}" "C  {}" "D  {}"
  shows "hausdorff_distance (A  B) (C  D)  max (hausdorff_distance A C) (hausdorff_distance B D)"
proof (cases "bounded A  bounded B  bounded C  bounded D")
  case False
  then have "hausdorff_distance (A  B) (C  D) = 0"
    unfolding hausdorff_distance_def by auto
  then show ?thesis
    by (simp add: hausdorff_distance_nonneg le_max_iff_disj)
next
  case True
  show ?thesis
  proof (rule hausdorff_distanceI, auto)
    fix x assume H: "x  A"
    have "infdist x (C  D)  infdist x C"
      by (simp add: assms infdist_union_min)
    also have "...  hausdorff_distance A C"
      apply (rule infdist_le_hausdorff_distance) using H True by auto
    also have "...  max (hausdorff_distance A C) (hausdorff_distance B D)"
      by auto
    finally show "infdist x (C  D)  max (hausdorff_distance A C) (hausdorff_distance B D)"
      by simp
  next
    fix x assume H: "x  B"
    have "infdist x (C  D)  infdist x D"
      by (simp add: assms infdist_union_min)
    also have "...  hausdorff_distance B D"
      apply (rule infdist_le_hausdorff_distance) using H True by auto
    also have "...  max (hausdorff_distance A C) (hausdorff_distance B D)"
      by auto
    finally show "infdist x (C  D)  max (hausdorff_distance A C) (hausdorff_distance B D)"
      by simp
  next
    fix x assume H: "x  C"
    have "infdist x (A  B)  infdist x A"
      by (simp add: assms infdist_union_min)
    also have "...  hausdorff_distance C A"
      apply (rule infdist_le_hausdorff_distance) using H True by auto
    also have "...  max (hausdorff_distance A C) (hausdorff_distance B D)"
      using hausdorff_distance_sym[of A C] by auto
    finally show "infdist x (A  B)  max (hausdorff_distance A C) (hausdorff_distance B D)"
      by simp
  next
    fix x assume H: "x  D"
    have "infdist x (A  B)  infdist x B"
      by (simp add: assms infdist_union_min)
    also have "...  hausdorff_distance D B"
      apply (rule infdist_le_hausdorff_distance) using H True by auto
    also have "...  max (hausdorff_distance A C) (hausdorff_distance B D)"
      using hausdorff_distance_sym[of B D] by auto
    finally show "infdist x (A  B)  max (hausdorff_distance A C) (hausdorff_distance B D)"
      by simp
  qed (simp add: le_max_iff_disj)
qed

end (*of theory Hausdorff_Distance*)

Theory Isometries

(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
    License: BSD
*)

section ‹Isometries›

theory Isometries
  imports Library_Complements Hausdorff_Distance
begin

text ‹Isometries, i.e., functions that preserve distances, show up very often in mathematics.
We introduce a dedicated definition, and show its basic properties.›

definition isometry_on::"('a::metric_space) set  ('a  ('b::metric_space))  bool"
  where "isometry_on X f = (x  X. y  X. dist (f x) (f y) = dist x y)"

definition isometry :: "('a::metric_space  'b::metric_space)  bool"
  where "isometry f  isometry_on UNIV f  range f = UNIV"

lemma isometry_on_subset:
  assumes "isometry_on X f"
          "Y  X"
  shows "isometry_on Y f"
using assms unfolding isometry_on_def by auto

lemma isometry_onI [intro?]:
  assumes "x y. x  X  y  X  dist (f x) (f y) = dist x y"
  shows "isometry_on X f"
using assms unfolding isometry_on_def by auto

lemma isometry_onD:
  assumes "isometry_on X f"
          "x  X" "y  X"
  shows "dist (f x) (f y) = dist x y"
using assms unfolding isometry_on_def by auto

lemma isometryI [intro?]:
  assumes "x y. dist (f x) (f y) = dist x y"
          "range f = UNIV"
  shows "isometry f"
unfolding isometry_def isometry_on_def using assms by auto

lemma
  assumes "isometry_on X f"
  shows isometry_on_lipschitz: "1-lipschitz_on X f"
    and isometry_on_uniformly_continuous: "uniformly_continuous_on X f"
    and isometry_on_continuous: "continuous_on X f"
proof -
  show "1-lipschitz_on X f" apply (rule lipschitz_onI) using isometry_onD[OF assms] by auto
  then show "uniformly_continuous_on X f" "continuous_on X f"
    using lipschitz_on_uniformly_continuous lipschitz_on_continuous_on by auto
qed

lemma isometryD:
  assumes "isometry f"
  shows "isometry_on UNIV f"
        "dist (f x) (f y) = dist x y"
        "range f = UNIV"
        "1-lipschitz_on UNIV f"
        "uniformly_continuous_on UNIV f"
        "continuous_on UNIV f"
using assms unfolding isometry_def isometry_on_def apply auto
using isometry_on_lipschitz isometry_on_uniformly_continuous isometry_on_continuous assms unfolding isometry_def by blast+

lemma isometry_on_injective:
  assumes "isometry_on X f"
  shows "inj_on f X"
using assms inj_on_def isometry_on_def by force

lemma isometry_on_compose:
  assumes "isometry_on X f"
          "isometry_on (f`X) g"
  shows "isometry_on X (λx. g(f x))"
using assms unfolding isometry_on_def by auto

lemma isometry_on_cong:
  assumes "isometry_on X f"
          "x. x  X  g x = f x"
  shows "isometry_on X g"
using assms unfolding isometry_on_def by auto

lemma isometry_on_inverse:
  assumes "isometry_on X f"
  shows "isometry_on (f`X) (inv_into X f)"
        "x. x  X  (inv_into X f) (f x) = x"
        "y. y  f`X  f (inv_into X f y) = y"
        "bij_betw f X (f`X)"
proof -
  show *: "bij_betw f X (f`X)"
    using assms unfolding bij_betw_def inj_on_def isometry_on_def by force
  show "isometry_on (f`X) (inv_into X f)"
    using assms unfolding isometry_on_def
    by (auto) (metis (mono_tags, lifting) dist_eq_0_iff inj_on_def inv_into_f_f)
  fix x assume "x  X"
  then show "(inv_into X f) (f x) = x"
    using * by (simp add: bij_betw_def)
next
  fix y assume "y  f`X"
  then show "f (inv_into X f y) = y"
    by (simp add: f_inv_into_f)
qed

lemma isometry_inverse:
  assumes "isometry f"
  shows "isometry (inv f)"
        "bij f"
using isometry_on_inverse[OF isometryD(1)[OF assms]] isometryD(3)[OF assms]
unfolding isometry_def by (auto simp add: bij_imp_bij_inv bij_is_surj)

lemma isometry_on_homeomorphism:
  assumes "isometry_on X f"
  shows "homeomorphism X (f`X) f (inv_into X f)"
        "homeomorphism_on X f"
        "X homeomorphic f`X"
proof -
  show *: "homeomorphism X (f`X) f (inv_into X f)"
    apply (rule homeomorphismI) using uniformly_continuous_imp_continuous[OF isometry_on_uniformly_continuous]
    isometry_on_inverse[OF assms] assms by auto
  then show "X homeomorphic f`X"
    unfolding homeomorphic_def by auto
  show "homeomorphism_on X f"
    unfolding homeomorphism_on_def using * by auto
qed

lemma isometry_homeomorphism:
  fixes f::"('a::metric_space)  ('b::metric_space)"
  assumes "isometry f"
  shows "homeomorphism UNIV UNIV f (inv f)"
        "(UNIV::'a set) homeomorphic (UNIV::'b set)"
using isometry_on_homeomorphism[OF isometryD(1)[OF assms]] isometryD(3)[OF assms] by auto

lemma isometry_on_closure:
  assumes "isometry_on X f"
          "continuous_on (closure X) f"
  shows "isometry_on (closure X) f"
proof (rule isometry_onI)
  fix x y assume "x  closure X" "y  closure X"
  obtain u v::"nat  'a" where *: "n. u n  X" "u  x"
                                   "n. v n  X" "v  y"
    using x  closure X y  closure X unfolding closure_sequential by blast
  have "(λn. f (u n))  f x"
    using *(1) *(2) x  closure X ‹continuous_on (closure X) f
    unfolding comp_def continuous_on_closure_sequentially[of X f] by auto
  moreover have "(λn. f (v n))  f y"
    using *(3) *(4) y  closure X ‹continuous_on (closure X) f
    unfolding comp_def continuous_on_closure_sequentially[of X f] by auto
  ultimately have "(λn. dist (f (u n)) (f (v n)))  dist (f x) (f y)"
    by (simp add: tendsto_dist)
  then have "(λn. dist (u n) (v n))  dist (f x) (f y)"
    using assms(1) *(1) *(3) unfolding isometry_on_def by auto
  moreover have "(λn. dist (u n) (v n))  dist x y"
    using *(2) *(4) by (simp add: tendsto_dist)
  ultimately show "dist (f x) (f y) = dist x y" using LIMSEQ_unique by auto
qed

lemma isometry_extend_closure:
  fixes f::"('a::metric_space)  ('b::complete_space)"
  assumes "isometry_on X f"
  shows "g. isometry_on (closure X) g  (xX. g x = f x)"
proof -
  obtain g where g: "x. x  X  g x = f x" "uniformly_continuous_on (closure X) g"
    using uniformly_continuous_on_extension_on_closure[OF isometry_on_uniformly_continuous[OF assms]] by metis
  have "isometry_on (closure X) g"
    apply (rule isometry_on_closure, rule isometry_on_cong[OF assms])
    using g uniformly_continuous_imp_continuous[OF g(2)] by auto
  then show ?thesis using g(1) by auto
qed

lemma isometry_on_complete_image:
  assumes "isometry_on X f"
          "complete X"
  shows "complete (f`X)"
proof (rule completeI)
  fix u :: "nat  'b" assume u: "n. u n  f`X" "Cauchy u"
  define v where "v = (λn. inv_into X f (u n))"
  have "v n  X" for n
    unfolding v_def by (simp add: inv_into_into u(1))
  have "dist (v n) (v m) = dist (u n) (u m)" for m n
    using u(1) isometry_on_inverse[OF ‹isometry_on X f] unfolding isometry_on_def v_def by (auto simp add: inv_into_into)
  then have "Cauchy v"
    using u(2) unfolding Cauchy_def by auto
  obtain l where "l  X" "v  l"
    apply (rule completeE[OF ‹complete X _ ‹Cauchy v]) using n. v n  X by auto
  have "(λn. f (v n))  f l"
    apply (rule continuous_on_tendsto_compose[OF isometry_on_continuous[OF ‹isometry_on X f]])
    using n. v n  X l  X v  l by auto
  moreover have "f(v n) = u n" for n
    unfolding v_def by (simp add: f_inv_into_f u(1))
  ultimately have "u  f l" by auto
  then show "m  f`X. u  m" using l  X by auto
qed

lemma isometry_on_id [simp]:
  "isometry_on A (λx. x)"
  "isometry_on A id"
unfolding isometry_on_def by auto

lemma isometry_on_add [simp]:
  "isometry_on A (λx. x + (t::'a::real_normed_vector))"
unfolding isometry_on_def by auto

lemma isometry_on_minus [simp]:
  "isometry_on A (λ(x::'a::real_normed_vector). -x)"
unfolding isometry_on_def by (auto simp add: dist_minus)

lemma isometry_on_diff [simp]:
  "isometry_on A (λx. (t::'a::real_normed_vector) - x)"
unfolding isometry_on_def by (auto, metis add_uminus_conv_diff dist_add_cancel dist_minus)

lemma isometry_preserves_bounded:
  assumes "isometry_on X f"
          "A  X"
  shows "bounded (f`A)  bounded A"
unfolding bounded_two_points using assms(2) isometry_onD[OF assms(1)] by auto (metis assms(2) rev_subsetD)+

lemma isometry_preserves_infdist:
  "infdist (f x) (f`A) = infdist x A"
  if "isometry_on X f" "A  X" "x  X"
  using that by (simp add: infdist_def image_comp isometry_on_def subset_iff)

lemma isometry_preserves_hausdorff_distance:
  "hausdorff_distance (f`A) (f`B) = hausdorff_distance A B"
  if "isometry_on X f" "A  X" "B  X"
  using that isometry_preserves_infdist [OF that(1) that(2)]
  isometry_preserves_infdist [OF that(1) that(3)]
  isometry_preserves_bounded [OF that(1) that(2)]
  isometry_preserves_bounded [OF that(1) that(3)]
  by (simp add: hausdorff_distance_def image_comp subset_eq)

lemma isometry_on_UNIV_iterates:
  fixes f::"('a::metric_space)  'a"
  assumes "isometry_on UNIV f"
  shows "isometry_on UNIV (f^^n)"
by (induction n, auto, rule isometry_on_compose[of _ _ f], auto intro: isometry_on_subset[OF assms])

lemma isometry_iterates:
  fixes f::"('a::metric_space)  'a"
  assumes "isometry f"
  shows "isometry (f^^n)"
using isometry_on_UNIV_iterates[OF isometryD(1)[OF assms], of n] bij_fn[OF isometry_inverse(2)[OF assms], of n]
unfolding isometry_def by (simp add: bij_is_surj)

section ‹Geodesic spaces›

text ‹A geodesic space is a metric space in which any pair of points can be joined by a geodesic segment,
i.e., an isometrically embedded copy of a segment in the real line. Most spaces in geometry are
geodesic. We introduce in this section the corresponding class of metric spaces. First, we study
properties of general geodesic segments in metric spaces.›

subsection ‹Geodesic segments in general metric spaces›

definition geodesic_segment_between::"('a::metric_space) set  'a  'a  bool"
  where "geodesic_segment_between G x y = (g::(real  'a). g 0 = x  g (dist x y) = y  isometry_on {0..dist x y} g  G = g`{0..dist x y})"

definition geodesic_segment::"('a::metric_space) set  bool"
  where "geodesic_segment G = (x y. geodesic_segment_between G x y)"

text ‹We also introduce the parametrization of a geodesic segment. It is convenient to use the
following definition, which guarantees that the point is on $G$ even without checking that $G$
is a geodesic segment or that the parameter is in the reasonable range: this shortens some
arguments below.›

definition geodesic_segment_param::"('a::metric_space) set  'a  real  'a"
  where "geodesic_segment_param G x t = (if w. w  G  dist x w = t then SOME w. w  G  dist x w = t else SOME w. w  G)"

lemma geodesic_segment_betweenI:
  assumes "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
  shows "geodesic_segment_between G x y"
unfolding geodesic_segment_between_def apply (rule exI[of _ g]) using assms by auto

lemma geodesic_segmentI [intro, simp]:
  assumes "geodesic_segment_between G x y"
  shows "geodesic_segment G"
unfolding geodesic_segment_def using assms by auto

lemma geodesic_segmentI2 [intro]:
  assumes "isometry_on {a..b} g" "a  (b::real)"
  shows "geodesic_segment_between (g`{a..b}) (g a) (g b)"
        "geodesic_segment (g`{a..b})"
proof -
  define h where "h = (λt. g (t+a))"
  have *: "isometry_on {0..b-a} h"
    apply (rule isometry_onI)
    using ‹isometry_on {a..b} g a  b by (auto simp add: isometry_on_def h_def)
  have **: "dist (h 0) (h (b-a)) = b-a"
    using isometry_onD[OF ‹isometry_on {0..b-a} h, of 0 "b-a"] a  b unfolding dist_real_def by auto
  have "geodesic_segment_between (h`{0..b-a}) (h 0) (h (b-a))"
    unfolding geodesic_segment_between_def apply (rule exI[of _ h]) unfolding ** using * by auto
  moreover have "g`{a..b} = h`{0..b-a}"
    unfolding h_def apply (auto simp add: image_iff)
    by (metis add.commute atLeastAtMost_iff diff_ge_0_iff_ge diff_right_mono le_add_diff_inverse)
  moreover have "h 0 = g a" "h (b-a) = g b" unfolding h_def by auto
  ultimately show "geodesic_segment_between (g`{a..b}) (g a) (g b)" by auto
  then show "geodesic_segment (g`{a..b})" unfolding geodesic_segment_def by auto
qed

lemma geodesic_segmentD:
  assumes "geodesic_segment_between G x y"
  shows "g::(real  _). (g t = x  g (t + dist x y) = y  isometry_on {t..t+dist x y} g  G = g`{t..t+dist x y})"
proof -
  obtain h where h: "h 0 = x" "h (dist x y) = y" "isometry_on {0..dist x y} h" "G = h`{0..dist x y}"
    by (meson ‹geodesic_segment_between G x y geodesic_segment_between_def)
  have * [simp]: "(λx. x - t) ` {t..t + dist x y} = {0..dist x y}" by auto
  define g where "g = (λs. h (s - t))"
  have "g t = x" "g (t + dist x y) = y" using h assms(1) unfolding g_def by auto
  moreover have "isometry_on {t..t+dist x y} g"
    unfolding g_def apply (rule isometry_on_compose[of _ _ h])
    by (simp add: dist_real_def isometry_on_def, simp add: h(3))
  moreover have "g` {t..t + dist x y} = G" unfolding g_def h(4) using * by (metis image_image)
  ultimately show ?thesis by auto
qed

lemma geodesic_segment_endpoints [simp]:
  assumes "geodesic_segment_between G x y"
  shows "x  G" "y  G" "G  {}"
using assms unfolding geodesic_segment_between_def
  by (auto, metis atLeastAtMost_iff image_eqI less_eq_real_def zero_le_dist)

lemma geodesic_segment_commute:
  assumes "geodesic_segment_between G x y"
  shows "geodesic_segment_between G y x"
proof -
  obtain g::"real'a" where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
    by (meson ‹geodesic_segment_between G x y geodesic_segment_between_def)
  define h::"real'a" where "h = (λt. g(dist x y-t))"
  have "(λt. dist x y -t)`{0..dist x y} = {0..dist x y}" by auto
  then have "h`{0..dist x y} = G" unfolding g(4) h_def by (metis image_image)
  moreover have "h 0 = y" "h (dist x y) = x" unfolding h_def using g by auto
  moreover have "isometry_on {0..dist x y} h"
    unfolding h_def apply (rule isometry_on_compose[of _ _ g]) using g(3) by auto
  ultimately show ?thesis
    unfolding geodesic_segment_between_def by (auto simp add: dist_commute)
qed

lemma geodesic_segment_dist:
  assumes "geodesic_segment_between G x y" "a  G"
  shows "dist x a + dist a y = dist x y"
proof -
  obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
    by (meson ‹geodesic_segment_between G x y geodesic_segment_between_def)
  obtain t where t: "t  {0..dist x y}" "a = g t"
    using g(4) assms by auto
  have "dist x a = t" using isometry_onD[OF g(3) _ t(1), of 0]
    unfolding g(1) dist_real_def t(2) using t(1) by auto
  moreover have "dist a y = dist x y - t" using isometry_onD[OF g(3) _ t(1), of "dist x y"]
    unfolding g(2) dist_real_def t(2) using t(1) by (auto simp add: dist_commute)
  ultimately show ?thesis by auto
qed

lemma geodesic_segment_dist_unique:
  assumes "geodesic_segment_between G x y" "a  G" "b  G" "dist x a = dist x b"
  shows "a = b"
proof -
  obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
    by (meson ‹geodesic_segment_between G x y geodesic_segment_between_def)
  obtain ta where ta: "ta  {0..dist x y}" "a = g ta"
    using g(4) assms by auto
  have *: "dist x a = ta"
    unfolding g(1)[symmetric] ta(2) using isometry_onD[OF g(3), of 0 ta]
    unfolding dist_real_def using ta(1) by auto
  obtain tb where tb: "tb  {0..dist x y}" "b = g tb"
    using g(4) assms by auto
  have "dist x b = tb"
    unfolding g(1)[symmetric] tb(2) using isometry_onD[OF g(3), of 0 tb]
    unfolding dist_real_def using tb(1) by auto
  then have "ta = tb" using * ‹dist x a = dist x b by auto
  then show "a = b" using ta(2) tb(2) by auto
qed

lemma geodesic_segment_union:
  assumes "dist x z = dist x y + dist y z"
          "geodesic_segment_between G x y" "geodesic_segment_between H y z"
  shows "geodesic_segment_between (G  H) x z"
        "G  H = {y}"
proof -
  obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
    by (meson ‹geodesic_segment_between G x y geodesic_segment_between_def)
  obtain h where h: "h (dist x y) = y" "h (dist x z) = z" "isometry_on {dist x y..dist x z} h" "H = h`{dist x y..dist x z}"
    unfolding ‹dist x z = dist x y + dist y z
    using geodesic_segmentD[OF ‹geodesic_segment_between H y z, of "dist x y"] by auto
  define f where "f = (λt. if t  dist x y then g t else h t)"
  have fg: "f t = g t" if "t  dist x y" for t
    unfolding f_def using that by auto
  have fh: "f t = h t" if "t  dist x y" for t
    unfolding f_def apply (cases "t > dist x y") using that g(2) h(1) by auto

  have "f 0 = x" "f (dist x z) = z" using fg fh g(1) h(2) assms(1) by auto

  have "f`{0..dist x z} = f`{0..dist x y}  f`{dist x y..dist x z}"
    unfolding assms(1) image_Un[symmetric] by (simp add: ivl_disj_un_two_touch(4))
  moreover have "f`{0..dist x y} = G"
    unfolding g(4) using fg image_cong by force
  moreover have "f`{dist x y..dist x z} = H"
    unfolding h(4) using fh image_cong by force
  ultimately have "f`{0..dist x z} = G  H" by simp

  have Ifg: "dist (f s) (f t) = s-t" if "0  t" "t  s" "s  dist x y" for s t
    using that fg[of s] fg[of t] isometry_onD[OF g(3), of s t] unfolding dist_real_def by auto
  have Ifh: "dist (f s) (f t) = s-t" if "dist x y  t" "t  s" "s  dist x z" for s t
    using that fh[of s] fh[of t] isometry_onD[OF h(3), of s t] unfolding dist_real_def by auto

  have I: "dist (f s) (f t) = s-t" if "0  t" "t  s" "s  dist x z" for s t
  proof -
    consider "t  dist x y  s  dist x y" | "s  dist x y" | "t  dist x y" by fastforce
    then show ?thesis
    proof (cases)
      case 1
      have "dist (f t) (f s)  dist (f t) (f (dist x y)) + dist (f (dist x y)) (f s)"
        using dist_triangle by auto
      also have "...  (dist x y - t) + (s - dist x y)"
        using that 1 Ifg[of t "dist x y"] Ifh[of "dist x y" s] by (auto simp add: dist_commute intro: mono_intros)
      finally have *: "dist (f t) (f s)  s - t" by simp

      have "dist x z  dist (f 0) (f t) + dist (f t) (f s) + dist (f s) (f (dist x z))"
        unfolding f 0 = x f (dist x z) = z using dist_triangle4 by auto
      also have "...  t + dist (f t) (f s) + (dist x z - s)"
        using that 1 Ifg[of 0 t] Ifh[of s "dist x z"] by (auto simp add: dist_commute intro: mono_intros)
      finally have "s - t  dist (f t) (f s)" by auto
      then show "dist (f s) (f t) = s-t" using * dist_commute by auto
    next
      case 2
      then show ?thesis using Ifg that by auto
    next
      case 3
      then show ?thesis using Ifh that by auto
    qed
  qed
  have "isometry_on {0..dist x z} f"
    unfolding isometry_on_def dist_real_def using I
    by (auto, metis abs_of_nonneg dist_commute dist_real_def le_cases zero_le_dist)
  then show "geodesic_segment_between (G  H) x z"
    unfolding geodesic_segment_between_def
    using f 0 = x f (dist x z) = z f`{0..dist x z} = G  H by auto
  have "G  H  {y}"
  proof (auto)
    fix a assume a: "a  G" "a  H"
    obtain s where s: "s  {0..dist x y}" "a = g s" using a g(4) by auto
    obtain t where t: "t  {dist x y..dist x z}" "a = h t" using a h(4) by auto
    have "a = f s" using fg s by auto
    moreover have "a = f t" using fh t by auto
    ultimately have "s = t" using isometry_onD[OF ‹isometry_on {0..dist x z} f, of s t] s(1) t(1) by auto
    then have "s = dist x y" using s t by auto
    then show "a = y" using s(2) g by auto
  qed
  then show "G  H = {y}" using assms by auto
qed

lemma geodesic_segment_dist_le:
  assumes "geodesic_segment_between G x y" "a  G" "b  G"
  shows "dist a b  dist x y"
proof -
  obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
    by (meson ‹geodesic_segment_between G x y geodesic_segment_between_def)
  obtain s t where st: "s  {0..dist x y}" "t  {0..dist x y}" "a = g s" "b = g t"
    using g(4) assms by auto
  have "dist a b = abs(s-t)" using isometry_onD[OF g(3) st(1) st(2)]
    unfolding st(3) st(4) dist_real_def by simp
  then show "dist a b  dist x y" using st(1) st(2) unfolding dist_real_def by auto
qed

lemma geodesic_segment_param [simp]:
  assumes "geodesic_segment_between G x y"
  shows "geodesic_segment_param G x 0 = x"
        "geodesic_segment_param G x (dist x y) = y"
        "t  {0..dist x y}  geodesic_segment_param G x t  G"
        "isometry_on {0..dist x y} (geodesic_segment_param G x)"
        "(geodesic_segment_param G x)`{0..dist x y} = G"
        "t  {0..dist x y}  dist x (geodesic_segment_param G x t) = t"
        "s  {0..dist x y}  t  {0..dist x y}  dist (geodesic_segment_param G x s) (geodesic_segment_param G x t) = abs(s-t)"
        "z  G  z = geodesic_segment_param G x (dist x z)"
proof -
  obtain g::"real'a" where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
    by (meson ‹geodesic_segment_between G x y geodesic_segment_between_def)
  have *: "g t  G  dist x (g t) = t" if "t  {0..dist x y}" for t
    using isometry_onD[OF g(3), of 0 t] that g(1) g(4) unfolding dist_real_def by auto
  have G: "geodesic_segment_param G x t = g t" if "t  {0..dist x y}" for t
  proof -
    have A: "geodesic_segment_param G x t  G  dist x (geodesic_segment_param G x t) = t"
      using *[OF that] unfolding geodesic_segment_param_def apply auto
      using *[OF that] by (metis (mono_tags, lifting) someI)+
    obtain s where s: "geodesic_segment_param G x t = g s" "s  {0..dist x y}"
      using A g(4) by auto
    have "s = t" using *[OF s  {0..dist x y}] A unfolding s(1) by auto
    then show ?thesis using s by auto
  qed
  show "geodesic_segment_param G x 0 = x"
       "geodesic_segment_param G x (dist x y) = y"
       "t  {0..dist x y}  geodesic_segment_param G x t  G"
       "isometry_on {0..dist x y} (geodesic_segment_param G x)"
       "(geodesic_segment_param G x)`{0..dist x y} = G"
       "t  {0..dist x y}  dist x (geodesic_segment_param G x t) = t"
       "s  {0..dist x y}  t  {0..dist x y}  dist (geodesic_segment_param G x s) (geodesic_segment_param G x t) = abs(s-t)"
       "z  G  z = geodesic_segment_param G x (dist x z)"
    using G g apply (auto simp add: rev_image_eqI)
    using G isometry_on_cong * atLeastAtMost_iff apply blast
    using G isometry_on_cong * atLeastAtMost_iff apply blast
    by (auto simp add: * dist_real_def isometry_onD)
qed

lemma geodesic_segment_param_in_segment:
  assumes "G  {}"
  shows "geodesic_segment_param G x t  G"
unfolding geodesic_segment_param_def
apply (auto, metis (mono_tags, lifting) someI)
using assms some_in_eq by fastforce

lemma geodesic_segment_reverse_param:
  assumes "geodesic_segment_between G x y"
          "t  {0..dist x y}"
  shows "geodesic_segment_param G y (dist x y - t) = geodesic_segment_param G x t"
proof -
  have * [simp]: "geodesic_segment_between G y x"
    using geodesic_segment_commute[OF assms(1)] by simp
  have "geodesic_segment_param G y (dist x y - t)  G"
    apply (rule geodesic_segment_param(3)[of _ _ x])
    using assms(2) by (auto simp add: dist_commute)
  moreover have "dist (geodesic_segment_param G y (dist x y - t)) x = t"
    using geodesic_segment_param(2)[OF *] geodesic_segment_param(7)[OF *, of "dist x y -t" "dist x y"] assms(2) by (auto simp add: dist_commute)
  moreover have "geodesic_segment_param G x t  G"
    apply (rule geodesic_segment_param(3)[OF assms(1)])
    using assms(2) by auto
  moreover have "dist (geodesic_segment_param G x t) x = t"
    using geodesic_segment_param(6)[OF assms] by (simp add: dist_commute)
  ultimately show ?thesis
    using geodesic_segment_dist_unique[OF assms(1)] by (simp add: dist_commute)
qed

lemma dist_along_geodesic_wrt_endpoint:
  assumes "geodesic_segment_between G x y"
          "u  G" "v  G"
  shows "dist u v = abs(dist u x - dist v x)"
proof -
  have *: "u = geodesic_segment_param G x (dist x u)" "v = geodesic_segment_param G x (dist x v)"
    using assms by auto
  have "dist u v = dist (geodesic_segment_param G x (dist x u)) (geodesic_segment_param G x (dist x v))"
    using * by auto
  also have "... = abs(dist x u - dist x v)"
    apply (rule geodesic_segment_param(7)[OF assms(1)]) using assms apply auto
    using geodesic_segment_dist_le geodesic_segment_endpoints(1) by blast+
  finally show ?thesis by (simp add: dist_commute)
qed

text ‹One often needs to restrict a geodesic segment to a subsegment. We introduce the tools
to express this conveniently.›
definition geodesic_subsegment::"('a::metric_space) set  'a  real  real  'a set"
  where "geodesic_subsegment G x s t = G  {z. dist x z  s  dist x z  t}"

text ‹A subsegment is always contained in the original segment.›
lemma geodesic_subsegment_subset:
  "geodesic_subsegment G x s t  G"
unfolding geodesic_subsegment_def by simp

text ‹A subsegment is indeed a geodesic segment, and its endpoints and parametrization can be
expressed in terms of the original segment.›
lemma geodesic_subsegment:
  assumes "geodesic_segment_between G x y"
          "0  s" "s  t" "t  dist x y"
  shows "geodesic_subsegment G x s t = (geodesic_segment_param G x)`{s..t}"
        "geodesic_segment_between (geodesic_subsegment G x s t) (geodesic_segment_param G x s) (geodesic_segment_param G x t)"
        "u. s  u  u  t  geodesic_segment_param (geodesic_subsegment G x s t) (geodesic_segment_param G x s) (u - s) = geodesic_segment_param G x u"
proof -
  show A: "geodesic_subsegment G x s t = (geodesic_segment_param G x)`{s..t}"
  proof (auto)
    fix y assume y: "y  geodesic_subsegment G x s t"
    have "y = geodesic_segment_param G x (dist x y)"
      apply (rule geodesic_segment_param(8)[OF assms(1)])
      using y geodesic_subsegment_subset by force
    moreover have "dist x y  s  dist x y  t"
      using y unfolding geodesic_subsegment_def by auto
    ultimately show "y  geodesic_segment_param G x ` {s..t}" by auto
  next
    fix u assume H: "s  u" "u  t"
    have *: "dist x (geodesic_segment_param G x u) = u"
      apply (rule geodesic_segment_param(6)[OF assms(1)]) using H assms by auto
    show "geodesic_segment_param G x u  geodesic_subsegment G x s t"
      unfolding geodesic_subsegment_def
      using geodesic_segment_param_in_segment[OF geodesic_segment_endpoints(3)[OF assms(1)]] by (auto simp add: * H)
  qed

  have *: "isometry_on {s..t} (geodesic_segment_param G x)"
    by (rule isometry_on_subset[of "{0..dist x y}"]) (auto simp add: assms)
  show B: "geodesic_segment_between (geodesic_subsegment G x s t) (geodesic_segment_param G x s) (geodesic_segment_param G x t)"
    unfolding A apply (rule geodesic_segmentI2) using * assms by auto

  fix u assume u: "s  u" "u  t"
  show "geodesic_segment_param (geodesic_subsegment G x s t) (geodesic_segment_param G x s) (u - s) = geodesic_segment_param G x u"
  proof (rule geodesic_segment_dist_unique[OF B])
    show "geodesic_segment_param (geodesic_subsegment G x s t) (geodesic_segment_param G x s) (u - s)  geodesic_subsegment G x s t"
      by (rule geodesic_segment_param_in_segment[OF geodesic_segment_endpoints(3)[OF B]])
    show "geodesic_segment_param G x u  geodesic_subsegment G x s t"
      unfolding A using u by auto
    have "dist (geodesic_segment_param G x s) (geodesic_segment_param (geodesic_subsegment G x s t) (geodesic_segment_param G x s) (u - s)) = u - s"
      using B assms u by auto
    moreover have "dist (geodesic_segment_param G x s) (geodesic_segment_param G x u) = u -s"
      using assms u by auto
    ultimately show "dist (geodesic_segment_param G x s) (geodesic_segment_param (geodesic_subsegment G x s t) (geodesic_segment_param G x s) (u - s)) =
        dist (geodesic_segment_param G x s) (geodesic_segment_param G x u)"
      by simp
  qed
qed

text ‹The parameterizations of a segment and a subsegment sharing an endpoint coincide where defined.›
lemma geodesic_segment_subparam:
  assumes "geodesic_segment_between G x z" "geodesic_segment_between H x y" "H  G" "t  {0..dist x y}"
  shows "geodesic_segment_param G x t = geodesic_segment_param H x t"
proof -
  have "geodesic_segment_param H x t  G"
    using assms(3) geodesic_segment_param(3)[OF assms(2) assms(4)] by auto
  then have "geodesic_segment_param H x t = geodesic_segment_param G x (dist x (geodesic_segment_param H x t))"
    using geodesic_segment_param(8)[OF assms(1)] by auto
  then show ?thesis using geodesic_segment_param(6)[OF assms(2) assms(4)] by auto
qed

text ‹A segment contains a subsegment between any of its points›
lemma geodesic_subsegment_exists:
  assumes "geodesic_segment G" "x  G" "y  G"
  shows "H. H  G  geodesic_segment_between H x y"
proof -
  obtain a0 b0 where Ga0b0: "geodesic_segment_between G a0 b0"
    using assms(1) unfolding geodesic_segment_def by auto
  text ‹Permuting the endpoints if necessary, we can ensure that the first endpoint $a$ is closer
  to $x$ than $y$.›
  have " a b. geodesic_segment_between G a b  dist x a  dist y a"
  proof (cases "dist x a0  dist y a0")
    case True
    show ?thesis
      apply (rule exI[of _ a0], rule exI[of _ b0]) using True Ga0b0 by auto
  next
    case False
    show ?thesis
      apply (rule exI[of _ b0], rule exI[of _ a0])
      using Ga0b0 geodesic_segment_commute geodesic_segment_dist[OF Ga0b0 x  G] geodesic_segment_dist[OF Ga0b0 y  G] False
      by (auto simp add: dist_commute)
  qed
  then obtain a b where Gab: "geodesic_segment_between G a b" "dist x a  dist y a"
    by auto
  have *: "0  dist x a" "dist x a  dist y a" "dist y a  dist a b"
    using Gab assms by (meson geodesic_segment_dist_le geodesic_segment_endpoints(1) zero_le_dist)+
  have **: "x = geodesic_segment_param G a (dist x a)" "y = geodesic_segment_param G a (dist y a)"
    using Gab x  G y  G by (metis dist_commute geodesic_segment_param(8))+
  define H where "H = geodesic_subsegment G a (dist x a) (dist y a)"
  have "H  G"
    unfolding H_def by (rule geodesic_subsegment_subset)
  moreover have "geodesic_segment_between H x y"
    unfolding H_def using geodesic_subsegment(2)[OF Gab(1) *] ** by auto
  ultimately show ?thesis by auto
qed

text ‹A geodesic segment is homeomorphic to an interval.›
lemma geodesic_segment_homeo_interval:
  assumes "geodesic_segment_between G x y"
  shows "{0..dist x y} homeomorphic G"
proof -
  obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
    by (meson ‹geodesic_segment_between G x y geodesic_segment_between_def)
  show ?thesis using isometry_on_homeomorphism(3)[OF g(3)] unfolding g(4) by simp
qed

text ‹Just like an interval, a geodesic segment is compact, connected, path connected, bounded,
closed, nonempty, and proper.›
lemma geodesic_segment_topology:
  assumes "geodesic_segment G"
  shows "compact G" "connected G" "path_connected G" "bounded G" "closed G" "G  {}" "proper G"
proof -
  show "compact G"
    using assms geodesic_segment_homeo_interval homeomorphic_compactness
    unfolding geodesic_segment_def by force
  show "path_connected G"
    using assms is_interval_path_connected geodesic_segment_homeo_interval homeomorphic_path_connectedness
    unfolding geodesic_segment_def
    by (metis is_interval_cc)
  then show "connected G"
    using path_connected_imp_connected by auto
  show "bounded G"
    by (rule compact_imp_bounded, fact)
  show "closed G"
    by (rule compact_imp_closed, fact)
  show "G  {}"
    using assms geodesic_segment_def geodesic_segment_endpoints(3) by auto
  show "proper G"
    using proper_of_compact ‹compact G by auto
qed

lemma geodesic_segment_between_x_x [simp]:
  "geodesic_segment_between {x} x x"
  "geodesic_segment {x}"
  "geodesic_segment_between G x x  G = {x}"
proof -
  show *: "geodesic_segment_between {x} x x"
    unfolding geodesic_segment_between_def apply (rule exI[of _ "λ_. x"]) unfolding isometry_on_def by auto
  then show "geodesic_segment {x}" by auto
  show "geodesic_segment_between G x x  G = {x}"
    using geodesic_segment_dist_le geodesic_segment_endpoints(2) * by fastforce
qed

lemma geodesic_segment_disconnection:
  assumes "geodesic_segment_between G x y" "z  G"
  shows "(connected (G - {z})) = (z = x  z = y)"
proof -
  obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
    by (meson ‹geodesic_segment_between G x y geodesic_segment_between_def)
  obtain t where t: "t  {0..dist x y}" "z = g t" using z  G g(4) by auto
  have "({0..dist x y} - {t}) homeomorphic (G - {g t})"
  proof -
    have *: "isometry_on ({0..dist x y} - {t}) g"
      apply (rule isometry_on_subset[OF g(3)]) by auto
    have "({0..dist x y} - {t}) homeomorphic g`({0..dist x y} - {t})"
      by (rule isometry_on_homeomorphism(3)[OF *])
    moreover have "g`({0..dist x y} - {t}) = G - {g t}"
      unfolding g(4) using isometry_on_injective[OF g(3)] t by (auto simp add: inj_onD)
    ultimately show ?thesis by auto
  qed
  moreover have "connected({0..dist x y} - {t}) = (t = 0  t = dist x y)"
    using t(1) by (auto simp add: connected_iff_interval, fastforce)
  ultimately have "connected (G - {z}) = (t = 0  t = dist x y)"
    unfolding z = g t[symmetric]using homeomorphic_connectedness by blast
  moreover have "(t = 0  t = dist x y) = (z = x  z = y)"
    using t g apply auto
    by (metis atLeastAtMost_iff isometry_on_inverse(2) order_refl zero_le_dist)+
  ultimately show ?thesis by auto
qed

lemma geodesic_segment_unique_endpoints:
  assumes "geodesic_segment_between G x y"
          "geodesic_segment_between G a b"
  shows "{x, y} = {a, b}"
by (metis geodesic_segment_disconnection assms(1) assms(2) doubleton_eq_iff geodesic_segment_endpoints(1) geodesic_segment_endpoints(2))

lemma geodesic_segment_subsegment:
  assumes "geodesic_segment G" "H  G" "compact H" "connected H" "H  {}"
  shows "geodesic_segment H"
proof -
  obtain x y where "geodesic_segment_between G x y"
    using assms unfolding geodesic_segment_def by auto
  obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
    by (meson ‹geodesic_segment_between G x y geodesic_segment_between_def)
  define L where "L = (inv_into {0..dist x y} g)`H"
  have "L  {0..dist x y}"
    unfolding L_def using isometry_on_inverse[OF ‹isometry_on {0..dist x y} g] assms(2) g(4) by auto
  have "isometry_on G (inv_into {0..dist x y} g)"
    using isometry_on_inverse[OF ‹isometry_on {0..dist x y} g] g(4) by auto
  then have "isometry_on H (inv_into {0..dist x y} g)"
    using H  G isometry_on_subset by auto
  then have "H homeomorphic L" unfolding L_def using isometry_on_homeomorphism(3) by auto
  then have "compact L  connected L"
    using assms homeomorphic_compactness homeomorphic_connectedness by blast
  then obtain a b where "L = {a..b}"
    using connected_compact_interval_1[of L] by auto
  have "a  b" using H  {} L = {a..b} unfolding L_def by auto
  then have "0  a" "b  dist x y" using L  {0..dist x y} L = {a..b} by auto
  have *: "H = g`{a..b}"
    by (metis L_def L = {a..b} assms(2) g(4) image_inv_into_cancel)
  show "geodesic_segment H"
    unfolding * apply (rule geodesic_segmentI2[OF _ a  b])
    apply (rule isometry_on_subset[OF g(3)]) using 0  a b  dist x y by auto
qed

text ‹The image under an isometry of a geodesic segment is still obviously a geodesic segment.›
lemma isometry_preserves_geodesic_segment_between:
  assumes "isometry_on X f"
          "G  X" "geodesic_segment_between G x y"
  shows "geodesic_segment_between (f`G) (f x) (f y)"
proof -
  obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
    by (meson ‹geodesic_segment_between G x y geodesic_segment_between_def)
  then have *: "f`G = (f o g) `{0..dist x y}" "f x = (f o g) 0" "f y = (f o g) (dist x y)"
    by auto
  show ?thesis
    unfolding * apply (intro geodesic_segmentI2(1))
    unfolding comp_def apply (rule isometry_on_compose[of _ g])
    using g(3) g(4) assms by (auto intro: isometry_on_subset)
qed

text ‹The sum of distances $d(w, x) + d(w, y)$ can be controlled using the distance from $w$
to a geodesic segment between $x$ and $y$.›
lemma geodesic_segment_distance:
  assumes "geodesic_segment_between G x y"
  shows "dist w x + dist w y  dist x y + 2 * infdist w G"
proof -
  have "z  G. infdist w G = dist w z"
    apply (rule infdist_proper_attained) using assms by (auto simp add: geodesic_segment_topology)
  then obtain z where z: "z  G" "infdist w G = dist w z" by auto
  have "dist w x + dist w y  (dist w z + dist z x) + (dist w z + dist z y)"
    by (intro mono_intros)
  also have "... = dist x z + dist z y + 2 * dist w z"
    by (auto simp add: dist_commute)
  also have "... = dist x y + 2 * infdist w G"
    using z(1) assms geodesic_segment_dist unfolding z(2) by auto
  finally show ?thesis by auto
qed

text ‹If a point $y$ is on a geodesic segment between $x$ and its closest projection $p$ on a set $A$,
then $p$ is also a closest projection of $y$, and the closest projection set of $y$ is contained in
that of $x$.›

lemma proj_set_geodesic_same_basepoint:
  assumes "p  proj_set x A" "geodesic_segment_between G p x" "y  G"
  shows "p  proj_set y A"
proof (rule proj_setI)
  show "p  A"
    using assms proj_setD by auto
  have *: "dist y p  dist y q" if "q  A" for q
  proof -
    have "dist p y + dist y x = dist p x"
      using assms geodesic_segment_dist by blast
    also have "...  dist q x"
      using proj_set_dist_le[OF q  A assms(1)] by (simp add: dist_commute)
    also have "...  dist q y + dist y x"
      by (intro mono_intros)
    finally show ?thesis
      by (simp add: dist_commute)
  qed
  have "dist y p  Inf (dist y ` A)"
    apply (rule cINF_greatest) using p  A * by auto
  then show "dist y p  infdist y A"
    unfolding infdist_def using p  A by auto
qed

lemma proj_set_subset:
  assumes "p  proj_set x A" "geodesic_segment_between G p x" "y  G"
  shows "proj_set y A  proj_set x A"
proof -
  have "z  proj_set x A" if "z  proj_set y A" for z
  proof (rule proj_setI)
    show "z  A" using that proj_setD by auto
    have "dist x z  dist x y + dist y z"
      by (intro mono_intros)
    also have "...  dist x y + dist y p"
      using proj_set_dist_le[OF proj_setD(1)[OF p  proj_set x A] that] by auto
    also have "... = dist x p"
      using assms geodesic_segment_commute geodesic_segment_dist by blast
    also have "... = infdist x A"
      using proj_setD(2)[OF assms(1)] by simp
    finally show "dist x z  infdist x A"
      by simp
  qed
  then show ?thesis by auto
qed

lemma proj_set_thickening:
  assumes "p  proj_set x Z"
          "0  D"
          "D  dist p x"
          "geodesic_segment_between G p x"
  shows "geodesic_segment_param G p D  proj_set x (zZ. cball z D)"
proof (rule proj_setI')
  have "dist p (geodesic_segment_param G p D) = D"
    using geodesic_segment_param(7)[OF assms(4), of 0 D]
    unfolding geodesic_segment_param(1)[OF assms(4)] using assms by simp
  then show "geodesic_segment_param G p D  (zZ. cball z D)"
    using proj_setD(1)[OF p  proj_set x Z] by force
  show "dist x (geodesic_segment_param G p D)  dist x y" if "y  (zZ. cball z D)" for y
  proof -
    obtain z where y: "y  cball z D" "z  Z" using y  (zZ. cball z D) by auto
    have "dist (geodesic_segment_param G p D) x + D = dist p x"
      using geodesic_segment_param(7)[OF assms(4), of D "dist p x"]
      unfolding geodesic_segment_param(2)[OF assms(4)] using assms by simp
    also have "...  dist z x"
      using proj_setD(2)[OF p  proj_set x Z] infdist_le[OF z  Z, of x] by (simp add: dist_commute)
    also have "...  dist z y + dist y x"
      by (intro mono_intros)
    also have "...  D + dist y x"
      using y by simp
    finally show ?thesis by (simp add: dist_commute)
  qed
qed

lemma proj_set_thickening':
  assumes "p  proj_set x Z"
          "0  D"
          "D  E"
          "E  dist p x"
          "geodesic_segment_between G p x"
  shows "geodesic_segment_param G p D  proj_set (geodesic_segment_param G p E) (zZ. cball z D)"
proof -
  define H where "H = geodesic_subsegment G p D (dist p x)"
  have H1: "geodesic_segment_between H (geodesic_segment_param G p D) x"
    apply (subst geodesic_segment_param(2)[OF ‹geodesic_segment_between G p x, symmetric])
    unfolding H_def apply (rule geodesic_subsegment(2)) using assms by auto
  have H2: "geodesic_segment_param G p E  H"
    unfolding H_def using assms geodesic_subsegment(1) by force
  have "geodesic_segment_param G p D  proj_set x (zZ. cball z D)"
    apply (rule proj_set_thickening) using assms by auto
  then show ?thesis
    by (rule proj_set_geodesic_same_basepoint[OF _ H1 H2])
qed

text ‹It is often convenient to use \emph{one} geodesic between $x$ and $y$, even if it is not unique.
We introduce a notation for such a choice of a geodesic, denoted \verb+{x--S--y}+ for such a geodesic
that moreover remains in the set $S$. We also enforce
the condition \verb+{x--S--y} = {y--S--x}+. When there is no such geodesic, we simply take
\verb+{x--S--y} = {x, y}+ for definiteness. It would be even better to enforce that, if
$a$ is on \verb+{x--S--y}+, then \verb+{x--S--y}+ is the union of \verb+{x--S--a}+ and \verb+{a--S--y}+, but
I do not know if such a choice is always possible -- such a choice of geodesics is
called a geodesic bicombing.
We also write \verb+{x--y}+ for \verb+{x--UNIV--y}+.›

definition some_geodesic_segment_between::"'a::metric_space  'a set  'a  'a set" ("(1{_--_--_})")
  where "some_geodesic_segment_between = (SOME f.  x y S. f x S y = f y S x
     (if (G. geodesic_segment_between G x y  G  S) then (geodesic_segment_between (f x S y) x y  (f x S y  S))
        else f x S y = {x, y}))"

abbreviation some_geodesic_segment_between_UNIV::"'a::metric_space  'a  'a set" ("(1{_--_})")
  where "some_geodesic_segment_between_UNIV x y  {x--UNIV--y}"

text ‹We prove that there is such a choice of geodesics, compatible with direction reversal. What
we do is choose arbitrarily a geodesic between $x$ and $y$ if it exists, and then use the geodesic
between $\min(x, y)$ and $\max(x,y)$, for any total order on the space, to ensure that we get the
same result from $x$ to $y$ or from $y$ to $x$.›

lemma some_geodesic_segment_between_exists:
  "f.  x y S. f x S y = f y S x
     (if (G. geodesic_segment_between G x y  G  S) then (geodesic_segment_between (f x S y) x y  (f x S y  S))
        else f x S y = {x, y})"
proof -
  define g::"'a  'a set  'a  'a set" where
    "g = (λx S y. if (G. geodesic_segment_between G x y  G  S) then (SOME G. geodesic_segment_between G x y  G  S) else {x, y})"
  have g1: "geodesic_segment_between (g x S y) x y  (g x S y  S)" if "G. geodesic_segment_between G x y  G  S" for x y S
    unfolding g_def using someI_ex[OF that] by auto
  have g2: "g x S y = {x, y}" if "¬(G. geodesic_segment_between G x y  G  S)" for x y S
    unfolding g_def using that by auto
  obtain r::"'a rel" where r: "well_order_on UNIV r"
    using well_order_on by auto
  have A: "x = y" if "(x, y)  r" "(y, x)  r" for x y
    using r that unfolding well_order_on_def linear_order_on_def partial_order_on_def antisym_def by auto
  have B: "(x, y)  r  (y, x)  r" for x y
    using r unfolding well_order_on_def linear_order_on_def total_on_def partial_order_on_def preorder_on_def refl_on_def by force

  define f where "f = (λx S y. if (x, y)  r then g x S y else g y S x)"
  have "f x S y = f y S x" for x y S unfolding f_def using r A B by auto
  moreover have "geodesic_segment_between (f x S y) x y  (f x S y  S)" if "G. geodesic_segment_between G x y  G  S" for x y S
    unfolding f_def using g1 geodesic_segment_commute that by smt
  moreover have "f x S y = {x, y}" if "¬(G. geodesic_segment_between G x y  G  S)" for x y S
    unfolding f_def using g2 that geodesic_segment_commute doubleton_eq_iff by metis
  ultimately show ?thesis by metis
qed

lemma some_geodesic_commute:
  "{x--S--y} = {y--S--x}"
unfolding some_geodesic_segment_between_def by (auto simp add: someI_ex[OF some_geodesic_segment_between_exists])

lemma some_geodesic_segment_description:
  "(G. geodesic_segment_between G x y  G  S)  geodesic_segment_between {x--S--y} x y"
  "(¬(G. geodesic_segment_between G x y  G  S))  {x--S--y} = {x, y}"
unfolding some_geodesic_segment_between_def by (simp add: someI_ex[OF some_geodesic_segment_between_exists])+

text ‹Basic topological properties of our chosen set of geodesics.›

lemma some_geodesic_compact [simp]:
  "compact {x--S--y}"
apply (cases "G. geodesic_segment_between G x y  G  S")
using some_geodesic_segment_description[of x y] geodesic_segment_topology[of "{x--S--y}"] geodesic_segment_def apply auto
  by blast

lemma some_geodesic_closed [simp]:
  "closed {x--S--y}"
by (rule compact_imp_closed[OF some_geodesic_compact[of x S y]])

lemma some_geodesic_bounded [simp]:
  "bounded {x--S--y}"
by (rule compact_imp_bounded[OF some_geodesic_compact[of x S y]])

lemma some_geodesic_endpoints [simp]:
  "x  {x--S--y}" "y  {x--S--y}" "{x--S--y}  {}"
apply (cases "G. geodesic_segment_between G x y  G  S") using some_geodesic_segment_description[of x y S] apply auto
apply (cases "G. geodesic_segment_between G x y  G  S") using some_geodesic_segment_description[of x y S] apply auto
apply (cases "G. geodesic_segment_between G x y  G  S") using geodesic_segment_endpoints(3) by (auto, blast)

lemma some_geodesic_subsegment:
  assumes "H  {x--S--y}" "compact H" "connected H" "H  {}"
  shows "geodesic_segment H"
apply (cases "G. geodesic_segment_between G x y  G  S")
using some_geodesic_segment_description[of x y] geodesic_segment_subsegment[OF _ assms] geodesic_segment_def apply auto[1]
using some_geodesic_segment_description[of x y] assms
by (metis connected_finite_iff_sing finite.emptyI finite.insertI finite_subset geodesic_segment_between_x_x(2))

lemma some_geodesic_in_subset:
  assumes "x  S" "y  S"
  shows "{x--S--y}  S"
apply (cases "G. geodesic_segment_between G x y  G  S")
unfolding some_geodesic_segment_between_def by (simp add: assms someI_ex[OF some_geodesic_segment_between_exists])+

lemma some_geodesic_same_endpoints [simp]:
  "{x--S--x} = {x}"
apply (cases "G. geodesic_segment_between G x x  G  S")
apply (meson geodesic_segment_between_x_x(3) some_geodesic_segment_description(1))
by (simp add: some_geodesic_segment_description(2))

subsection ‹Geodesic subsets›

text ‹A subset is \emph{geodesic} if any two of its points can be joined by a geodesic segment.
We prove basic properties of such a subset in this paragraph -- notably connectedness. A basic
example is given by convex subsets of vector spaces, as closed segments are geodesic.›

definition geodesic_subset::"('a::metric_space) set  bool"
  where "geodesic_subset S = (xS. yS. G. geodesic_segment_between G x y  G  S)"

lemma geodesic_subsetD:
  assumes "geodesic_subset S" "x  S" "y  S"
  shows "geodesic_segment_between {x--S--y} x y"
using assms some_geodesic_segment_description(1) unfolding geodesic_subset_def by blast

lemma geodesic_subsetI:
  assumes "x y. x  S  y  S  G. geodesic_segment_between G x y  G  S"
  shows "geodesic_subset S"
using assms unfolding geodesic_subset_def by auto

lemma geodesic_subset_empty:
  "geodesic_subset {}"
using geodesic_subsetI by auto

lemma geodesic_subset_singleton:
  "geodesic_subset {x}"
by (auto intro!: geodesic_subsetI geodesic_segment_between_x_x(1))

lemma geodesic_subset_path_connected:
  assumes "geodesic_subset S"
  shows "path_connected S"
proof -
  have "g. path g  path_image g  S  pathstart g = x  pathfinish g = y" if "x  S" "y  S" for x y
  proof -
    define G where "G = {x--S--y}"
    have *: "geodesic_segment_between G x y" "G  S" "x  G" "y  G"
      using assms that by (auto simp add: G_def geodesic_subsetD some_geodesic_in_subset that(1) that(2))
    then have "path_connected G"
      using geodesic_segment_topology(3) unfolding geodesic_segment_def by auto
    then have "g. path g  path_image g  G  pathstart g = x  pathfinish g = y"
      using * unfolding path_connected_def by auto
    then show ?thesis using G  S by auto
  qed
  then show ?thesis
    unfolding path_connected_def by auto
qed

text ‹To show that a segment in a normed vector space is geodesic, we will need to use its
length parametrization, which is given in the next lemma.›

lemma closed_segment_as_isometric_image:
  "((λt. x + (t/dist x y) *R (y - x))`{0..dist x y}) = closed_segment x y"
proof (auto simp add: closed_segment_def image_iff)
  fix t assume H: "0  t" "t  dist x y"
  show "u. x + (t / dist x y) *R (y - x) = (1 - u) *R x + u *R y  0  u  u  1"
    apply (rule exI[of _ "t/dist x y"])
    using H apply (auto simp add: algebra_simps divide_simps)
    apply (metis add_diff_cancel_left' add_diff_eq add_divide_distrib dist_eq_0_iff scaleR_add_left vector_fraction_eq_iff)
    done
next
  fix u::real assume H: "0  u" "u  1"
  show "t{0..dist x y}. (1 - u) *R x + u *R y = x + (t / dist x y) *R (y - x)"
    apply (rule bexI[of _ "u * dist x y"])
    using H by (auto simp add: algebra_simps mult_left_le_one_le)
qed

proposition closed_segment_is_geodesic:
  fixes x y::"'a::real_normed_vector"
  shows "isometry_on {0..dist x y} (λt. x + (t/dist x y) *R (y - x))"
        "geodesic_segment_between (closed_segment x y) x y"
        "geodesic_segment (closed_segment x y)"
proof -
  show *: "isometry_on {0..dist x y} (λt. x + (t/dist x y) *R (y - x))"
    unfolding isometry_on_def dist_norm
    apply (cases "x = y")
    by (auto simp add: scaleR_diff_left[symmetric] diff_divide_distrib[symmetric] norm_minus_commute)
  show "geodesic_segment_between (closed_segment x y) x y"
    unfolding closed_segment_as_isometric_image[symmetric]
    apply (rule geodesic_segment_betweenI[OF _ _ *]) by auto
  then show "geodesic_segment (closed_segment x y)"
    by auto
qed

text ‹We deduce that a convex set is geodesic.›

proposition convex_is_geodesic:
  assumes "convex (S::'a::real_normed_vector set)"
  shows "geodesic_subset S"
proof (rule geodesic_subsetI)
  fix x y assume H: "x  S" "y  S"
  show "G. geodesic_segment_between G x y  G  S"
    apply (rule exI[of _ "closed_segment x y"])
    apply (auto simp add: closed_segment_is_geodesic)
    using H assms convex_contains_segment by blast
qed


subsection ‹Geodesic spaces›

text ‹In this subsection, we define geodesic spaces (metric spaces in which there is a geodesic
segment joining any pair of points). We specialize the previous statements on geodesic segments to
these situations.›

class geodesic_space = metric_space +
  assumes geodesic: "geodesic_subset (UNIV::('a::metric_space) set)"

text ‹The simplest example of a geodesic space is a real normed vector space. Significant examples
also include graphs (with the graph distance), Riemannian manifolds, and $CAT(\kappa)$ spaces.›

instance real_normed_vector  geodesic_space
by (standard, simp add: convex_is_geodesic)

lemma (in geodesic_space) some_geodesic_is_geodesic_segment [simp]:
  "geodesic_segment_between {x--y} x (y::'a)"
  "geodesic_segment {x--y}"
using some_geodesic_segment_description(1)[of x y] geodesic_subsetD[OF geodesic] by (auto, blast)

lemma (in geodesic_space) some_geodesic_connected [simp]:
  "connected {x--y}" "path_connected {x--y}"
by (auto intro!: geodesic_segment_topology)

text ‹In geodesic spaces, we restate as simp rules all properties of the geodesic segment
parametrizations.›

lemma (in geodesic_space) geodesic_segment_param_in_geodesic_spaces [simp]:
  "geodesic_segment_param {x--y} x 0 = x"
  "geodesic_segment_param {x--y} x (dist x y) = y"
  "t  {0..dist x y}  geodesic_segment_param {x--y} x t  {x--y}"
  "isometry_on {0..dist x y} (geodesic_segment_param {x--y} x)"
  "(geodesic_segment_param {x--y} x)`{0..dist x y} = {x--y}"
  "t  {0..dist x y}  dist x (geodesic_segment_param {x--y} x t) = t"
  "s  {0..dist x y}  t  {0..dist x y}  dist (geodesic_segment_param {x--y} x s) (geodesic_segment_param {x--y} x t) = abs(s-t)"
  "z  {x--y}  z = geodesic_segment_param {x--y} x (dist x z)"
using geodesic_segment_param[OF some_geodesic_is_geodesic_segment(1)[of x y]] by auto


subsection ‹Uniquely geodesic spaces›

text ‹In this subsection, we define uniquely geodesic spaces, i.e., geodesic spaces in which,
additionally, there is a unique geodesic between any pair of points.›

class uniquely_geodesic_space = geodesic_space +
  assumes uniquely_geodesic: "x y G H. geodesic_segment_between G x y  geodesic_segment_between H x y  G = H"

text ‹To prove that a geodesic space is uniquely geodesic, it suffices to show that there is no loop,
i.e., if two geodesic segments intersect only at their endpoints, then they coincide.

Indeed, assume this holds, and consider two geodesics with the same endpoints. If they differ at
some time $t$, then consider the last time $a$ before $t$ where they coincide, and the first time
$b$ after $t$ where they coincide. Then the restrictions of the two geodesics to $[a,b]$ give
a loop, and a contradiction.›

lemma (in geodesic_space) uniquely_geodesic_spaceI:
  assumes "G H x (y::'a). geodesic_segment_between G x y  geodesic_segment_between H x y  G  H = {x, y}  x = y"
          "geodesic_segment_between G x y" "geodesic_segment_between H x (y::'a)"
  shows "G = H"
proof -
  obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
    by (meson ‹geodesic_segment_between G x y geodesic_segment_between_def)
  obtain h where h: "h 0 = x" "h (dist x y) = y" "isometry_on {0..dist x y} h" "H = h`{0..dist x y}"
    by (meson ‹geodesic_segment_between H x y geodesic_segment_between_def)
  have "g t = h t" if "t  {0..dist x y}" for t
  proof (rule ccontr)
    assume "g t  h t"
    define Z where "Z = {s  {0..dist x y}. g s = h s}"
    have "0  Z" "dist x y  Z" unfolding Z_def using g h by auto
    have "t  Z" unfolding Z_def using g t  h t by auto
    have [simp]: "closed Z"
    proof -
      have *: "Z = (λs. dist (g s) (h s))-`{0}  {0..dist x y}"
        unfolding Z_def by auto
      show ?thesis
        unfolding * apply (rule closed_vimage_Int)
        using isometry_on_continuous[OF g(3)] isometry_on_continuous[OF h(3)] continuous_on_dist by auto
    qed
    define a where "a = Sup (Z  {0..t})"
    have a: "a  Z  {0..t}"
      unfolding a_def apply (rule closed_contains_Sup, auto)
      using 0  Z that by auto
    then have "h a = g a" unfolding Z_def by auto
    define b where "b = Inf (Z  {t..dist x y})"
    have b: "b  Z  {t..dist x y}"
      unfolding b_def apply (rule closed_contains_Inf, auto)
      using ‹dist x y  Z that by auto
    then have "h b = g b" unfolding Z_def by auto
    have notZ: "s  Z" if "s  {a<..<b}" for s
    proof (rule ccontr, auto, cases "s  t")
      case True
      assume "s  Z"
      then have *: "s  Z  {0..t}" using that a True by auto
      have "s  a" unfolding a_def apply (rule cSup_upper) using * by auto
      then show False using that by auto
    next
      case False
      assume "s  Z"
      then have *: "s  Z  {t..dist x y}" using that b False by auto
      have "s  b" unfolding b_def apply (rule cInf_lower) using * by auto
      then show False using that by auto
    qed
    have "t  {a<..<b}" using a b t  Z less_eq_real_def by auto
    then have "a  b" by auto
    then have "dist (h a) (h b) = b-a"
      using isometry_onD[OF h(3), of a b] a b that unfolding dist_real_def by auto
    then have "dist (h a) (h b) > 0" using t  {a<..<b} by auto
    then have "h a  h b" by auto

    define G2 where "G2 = g`{a..b}"
    define H2 where "H2 = h`{a..b}"
    have "G2  H2  {h a, h b}"
    proof
      fix z assume z: "z  G2  H2"
      obtain sg where sg: "z = g sg" "sg  {a..b}" using z unfolding G2_def by auto
      obtain sh where sh: "z = h sh" "sh  {a..b}" using z unfolding H2_def by auto
      have "sg = dist x z"
        using isometry_onD[OF g(3), of 0 sg] a b sg(2) unfolding sg(1) g(1)[symmetric] dist_real_def by auto
      moreover have "sh = dist x z"
        using isometry_onD[OF h(3), of 0 sh] a b sh(2) unfolding sh(1) h(1)[symmetric] dist_real_def by auto
      ultimately have "sg = sh" by auto
      then have "sh  Z" using sg(1) sh(1) a b sh(2) unfolding Z_def by auto
      then have "sh  {a, b}" using notZ sh(2)
        by (metis IntD2 atLeastAtMost_iff atLeastAtMost_singleton greaterThanLessThan_iff inf_bot_left insertI2 insert_inter_insert not_le)
      then show "z  {h a, h b}" using sh(1) by auto
    qed
    then have "G2  H2 = {h a, h b}"
      using h a = g a h b = g b a  b unfolding H2_def G2_def apply auto
      unfolding h a = g a[symmetric] h b = g b[symmetric] by auto
    moreover have "geodesic_segment_between G2 (h a) (h b)"
      unfolding G2_def h a = g a h b = g b
      apply (rule geodesic_segmentI2) apply (rule isometry_on_subset[OF g(3)])
      using a b that by auto
    moreover have "geodesic_segment_between H2 (h a) (h b)"
      unfolding H2_def apply (rule geodesic_segmentI2) apply (rule isometry_on_subset[OF h(3)])
      using a b that by auto
    ultimately have "h a = h b" using assms(1) by auto
    then show False using h a  h b by simp
  qed
  then show "G = H" using g(4) h(4) by (simp add: image_def)
qed

context uniquely_geodesic_space
begin

lemma geodesic_segment_unique:
  "geodesic_segment_between G x y = (G = {x--(y::'a)})"
using uniquely_geodesic[of _ x y] by (meson some_geodesic_is_geodesic_segment)

lemma geodesic_segment_dist':
  assumes "dist x z = dist x y + dist y z"
  shows "y  {x--z}" "{x--z} = {x--y}  {y--z}"
proof -
  have "geodesic_segment_between ({x--y}  {y--z}) x z"
    using geodesic_segment_union[OF assms] by auto
  then show "{x--z} = {x--y}  {y--z}"
    using geodesic_segment_unique by auto
  then show "y  {x--z}" by auto
qed

lemma geodesic_segment_expression:
  "{x--z} = {y. dist x z = dist x y + dist y z}"
using geodesic_segment_dist'(1) geodesic_segment_dist[OF some_geodesic_is_geodesic_segment(1)] by auto

lemma geodesic_segment_split:
  assumes "(y::'a)  {x--z}"
  shows "{x--z} = {x--y}  {y--z}"
        "{x--y}  {y--z} = {y}"
apply (metis assms geodesic_segment_dist geodesic_segment_dist'(2) some_geodesic_is_geodesic_segment(1))
apply (rule geodesic_segment_union(2)[of x z], auto simp add: assms)
using assms geodesic_segment_expression by blast

lemma geodesic_segment_subparam':
  assumes "y  {x--z}" "t  {0..dist x y}"
  shows "geodesic_segment_param {x--z} x t = geodesic_segment_param {x--y} x t"
apply (rule geodesic_segment_subparam[of _ _ z _ y]) using assms apply auto
using geodesic_segment_split(1)[OF assms(1)] by auto

end (*of context uniquely_geodesic_space*)


subsection ‹A complete metric space with middles is geodesic.›

text ‹A complete space in which every pair of points has a middle (i.e., a point $m$ which
is half distance of $x$ and $y$) is geodesic: to construct a geodesic between $x_0$
and $y_0$, first choose a middle $m$, then middles of the pairs $(x_0,m)$ and $(m, y_0)$, and so
on. This will define the geodesic on dyadic points (and this is indeed an isometry on these dyadic
points. Then, extend it by uniform continuity to the whole segment $[0, dist x0 y0]$.

The formal proof will be done in a locale where $x_0$ and $y_0$ are fixed, for notational simplicity.
We define inductively the sequence of middles, in a function \verb+geod+ of two natural variables:
$geod n m$ corresponds to the image of the dyadic point $m/2^n$. It is defined inductively, by
$geod (n+1) (2m) = geod n m$, and $geod (n+1) (2m+1)$ is a middle of $geod n m$ and $geod n (m+1)$.
This is not a completely classical inductive definition, so one has to use \verb+function+ to define
it. Then, one checks inductively that it has all the properties we want, and use it to define the
geodesic segment on dyadic points. We will not use a canonical
representative for a dyadic point, but any representative (i.e., numerator and denominator
will not have to be coprime) -- this will not create problems as $geod$ does not depend on the choice
of the representative, by construction.›

locale complete_space_with_middle =
  fixes x0 y0::"'a::complete_space"
  assumes middles: "x y::'a. z. dist x z = (dist x y)/2  dist z y = (dist x y)/2"
begin

definition middle::"'a  'a  'a"
  where "middle x y = (SOME z. dist x z = (dist x y)/2  dist z y = (dist x y)/2)"

lemma middle:
  "dist x (middle x y) = (dist x y)/2"
  "dist (middle x y) y = (dist x y)/2"
unfolding middle_def using middles[of x y] by (metis (mono_tags, lifting) someI_ex)+

function geod::"nat  nat  'a" where
 "geod 0 0 = x0"
|"geod 0 (Suc m) = y0"
|"geod (Suc n) (2 * m) = geod n m"
|"geod (Suc n) (Suc (2*m)) = middle (geod n m) (geod n (Suc m))"
apply (auto simp add: double_not_eq_Suc_double)
by (metis One_nat_def dvd_mult_div_cancel list_decode.cases odd_Suc_minus_one odd_two_times_div_two_nat)
termination by lexicographic_order

text ‹By induction, the distance between successive points is $D/2^n$.›

lemma geod_distance_successor:
  "a < 2^n. dist (geod n a) (geod n (Suc a)) = dist x0 y0 / 2^n"
proof (induction n)
  case 0
  show ?case by auto
next
  case (Suc n)
  show ?case
  proof (auto)
    fix a::nat assume a: "a < 2 * 2^n"
    obtain m where m: "a = 2 * m  a = Suc (2 * m)" by (metis geod.elims)
    then have "m < 2^n" using a by auto
    consider "a = 2 * m" | "a = Suc(2*m)" using m by auto
    then show "dist (geod (Suc n) a) (geod (Suc n) (Suc a)) = dist x0 y0 / (2 * 2 ^ n)"
    proof (cases)
      case 1
      show ?thesis
        unfolding 1 apply auto
        unfolding middle using Suc.IH m < 2^n by auto
    next
      case 2
      have *: "Suc (Suc (2 * m)) = 2 * (Suc m)" by auto
      show ?thesis
        unfolding 2 apply auto
        unfolding * geod.simps(3) middle using Suc.IH m < 2^n by auto
    qed
  qed
qed

lemma geod_mult:
  "geod n a = geod (n + k) (a * 2^k)"
apply (induction k, auto) using geod.simps(3) by (metis mult.left_commute)

lemma geod_0:
  "geod n 0 = x0"
by (induction n, auto, metis geod.simps(3) semiring_normalization_rules(10))

lemma geod_end:
  "geod n (2^n) = y0"
by (induction n, auto)

text ‹By the triangular inequality, the distance between points separated by $(b-a)/2^n$ is at
most $D * (b-a)/2^n$.›

lemma geod_upper:
  assumes "a  b" "b  2^n"
  shows "dist (geod n a) (geod n b)  (b-a) * dist x0 y0 / 2^n"
proof -
  have *: "a+k > 2^n  dist (geod n a) (geod n (a+k))  k * dist x0 y0 / 2^n" for k
  proof (induction k)
    case 0 then show ?case by auto
  next
    case (Suc k)
    show ?case
    proof (cases "2 ^ n < a + Suc k")
      case True then show ?thesis by auto
    next
      case False
      then have *: "a + k < 2 ^ n" by auto
      have "dist (geod n a) (geod n (a + Suc k))  dist (geod n a) (geod n (a+k)) + dist (geod n (a+k)) (geod n (a+Suc k))"
        using dist_triangle by auto
      also have "...  k * dist x0 y0 / 2^n + dist x0 y0 / 2^n"
        using Suc.IH * geod_distance_successor by auto
      finally show ?thesis
        by (simp add: add_divide_distrib distrib_left mult.commute)
    qed
  qed
  show ?thesis using *[of "b-a"] assms by (simp add: of_nat_diff)
qed

text ‹In fact, the distance is exactly $D * (b-a)/2^n$, otherwise the extremities of the interval
would be closer than $D$, a contradiction.›

lemma geod_dist:
  assumes "a  b" "b  2^n"
  shows "dist (geod n a) (geod n b) = (b-a) * dist x0 y0 / 2^n"
proof -
  have "dist (geod n a) (geod n b)  (real b-a) * dist x0 y0 / 2^n"
    using geod_upper[of a b n] assms by auto
  moreover have "¬ (dist (geod n a) (geod n b) < (real b-a) * dist x0 y0 / 2^n)"
  proof (rule ccontr, simp)
    assume *: "dist (geod n a) (geod n b) < (real b-a) * dist x0 y0 / 2^n"
    have "dist x0 y0 = dist (geod n 0) (geod n (2^n))"
      using geod_0 geod_end by auto
    also have "...  dist (geod n 0) (geod n a) + dist (geod n a) (geod n b) + dist (geod n b) (geod n (2^n))"
      using dist_triangle4 by auto
    also have "... < a * dist x0 y0 / 2^n + (real b-a) * dist x0 y0 / 2^n + (2^n - real b) * dist x0 y0 / 2^n"
      using * assms geod_upper[of 0 a n] geod_upper[of b "2^n" n] by (auto intro: mono_intros)
    also have "... = dist x0 y0"
      using assms by (auto simp add: algebra_simps divide_simps)
    finally show "False" by auto
  qed
  ultimately show ?thesis by auto
qed

text ‹We deduce the same statement but for points that are not on the same level, by putting
them on a common multiple level.›

lemma geod_dist2:
  assumes "a  2^n" "b  2^p" "a/2^n  b / 2^p"
  shows "dist (geod n a) (geod p b) = (b/2^p - a/2^n) * dist x0 y0"
proof -
  define r where "r = max n p"
  define ar where "ar = a * 2^(r - n)"
  have a: "ar / 2^r = a / 2^n"
    unfolding ar_def r_def by (auto simp add: divide_simps semiring_normalization_rules(26))
  have A: "geod r ar = geod n a"
    unfolding ar_def r_def using geod_mult[of n a "max n p - n"] by auto
  define br where "br = b * 2^(r - p)"
  have b: "br / 2^r = b / 2^p"
    unfolding br_def r_def by (auto simp add: divide_simps semiring_normalization_rules(26))
  have B: "geod r br = geod p b"
    unfolding br_def r_def using geod_mult[of p b "max n p - p"] by auto

  have "dist (geod n a) (geod p b) = dist (geod r ar) (geod r br)"
    using A B by auto
  also have "... = (real br - ar) * dist x0 y0 / 2 ^r"
    apply (rule geod_dist)
    using a/2^n  b / 2^p unfolding a[symmetric] b[symmetric] apply (auto simp add: divide_simps)
    using b  2^p b apply (auto simp add: divide_simps)
    by (metis br_def le_add_diff_inverse2 max.cobounded2 mult.commute mult_le_mono2 r_def semiring_normalization_rules(26))
  also have "... = (real br / 2^r - real ar / 2^r) * dist x0 y0"
    by (auto simp add: algebra_simps divide_simps)
  finally show ?thesis using a b by auto
qed

text ‹Same thing but without a priori ordering of the points.›

lemma geod_dist3:
  assumes "a  2^n" "b  2^p"
  shows "dist (geod n a) (geod p b) = abs(b/2^p - a/2^n) * dist x0 y0"
apply (cases "a /2^n  b/2^p", auto)
apply (rule geod_dist2[OF assms], auto)
apply (subst dist_commute, rule geod_dist2[OF assms(2) assms(1)], auto)
done

text ‹Finally, we define a geodesic by extending what we have already defined on dyadic points,
thanks to the result of isometric extension of isometries taking their values
in complete spaces.›

lemma geod:
  shows "g. isometry_on {0..dist x0 y0} g  g 0 = x0  g (dist x0 y0) = y0"
proof (cases "x0 = y0")
  case True
  show ?thesis apply (rule exI[of _ "λ_. x0"]) unfolding isometry_on_def using True by auto
next
  case False
  define A where "A = {(real k/2^n) * dist x0 y0 |k n. k  2^n}"
  have "{0..dist x0 y0}  closure A"
  proof (auto simp add: closure_approachable dist_real_def)
    fix t::real assume t: "0  t" "t  dist x0 y0"
    fix e:: real assume "e > 0"
    then obtain n::nat where n: "dist x0 y0/e < 2^n"
      using one_less_numeral_iff real_arch_pow semiring_norm(76) by blast
    define k where "k = floor (2^n * t/ dist x0 y0)"
    have "k  2^n * t/ dist x0 y0" unfolding k_def by auto
    also have "...  2^n" using t False by (auto simp add: algebra_simps divide_simps)
    finally have "k  2^n" by auto
    have "k  0" using t False unfolding k_def by auto
    define l where "l = nat k"
    have "k = int l" "l  2^n" using k  0 k  2^n nat_le_iff unfolding l_def by auto

    have "abs (2^n * t/dist x0 y0 - k)  1" unfolding k_def by linarith
    then have "abs(t - k/2^n * dist x0 y0)  dist x0 y0 / 2^n"
      by (auto simp add: algebra_simps divide_simps False)
    also have "... < e" using n e > 0 by (auto simp add: algebra_simps divide_simps)
    finally have "abs(t - k/2^n * dist x0 y0) < e" by auto
    then have "abs(t - l/2^n * dist x0 y0) < e" using k = int l by auto
    moreover have "l/2^n * dist x0 y0  A" unfolding A_def using l  2^n by auto
    ultimately show "uA. abs(u - t) < e" by force
  qed

  text ‹For each dyadic point, we choose one representation of the form $K/2^N$, it is not important
  for us that it is the minimal one.›
  define index where "index = (λt. SOME i. t = real (fst i)/2^(snd i) * dist x0 y0  (fst i)  2^(snd i))"
  define K where "K = (λt. fst (index t))"
  define N where "N = (λt. snd (index t))"
  have t: "t = K t/ 2^(N t) * dist x0 y0  K t  2^(N t)" if "t  A" for t
  proof -
    obtain n k::nat where "t = k/2^n * dist x0 y0" "k  2^n" using t A unfolding A_def by auto
    then have *: "i. t = real (fst i)/2^(snd i) * dist x0 y0  (fst i)  2^(snd i)" by auto
    show ?thesis unfolding K_def N_def index_def using someI_ex[OF *] by auto
  qed

  text ‹We can now define our function on dyadic points.›
  define f where "f = (λt. geod (N t) (K t))"
  have "0  A" unfolding A_def by auto
  have "f 0 = x0"
  proof -
    have "0 = K 0 /2^(N 0) * dist x0 y0" using t 0  A by auto
    then have "K 0 = 0" using False by auto
    then show ?thesis unfolding f_def using geod_0 by auto
  qed
  have "dist x0 y0 = (real 1/2^0) * dist x0 y0" by auto
  then have "dist x0 y0  A" unfolding A_def by force
  have "f (dist x0 y0) = y0"
  proof -
    have "dist x0 y0 = K (dist x0 y0) / 2^(N (dist x0 y0)) * dist x0 y0"
      using t ‹dist x0 y0  A by auto
    then have "K (dist x0 y0) = 2^(N(dist x0 y0))" using False by (auto simp add: divide_simps)
    then show ?thesis unfolding f_def using geod_end by auto
  qed
  text ‹By construction, it is an isometry on dyadic points.›
  have "isometry_on A f"
  proof (rule isometry_onI)
    fix s t assume inA: "s  A" "t  A"
    have "dist (f s) (f t) = abs (K t/2^(N t) - K s/2^(N s)) * dist x0 y0"
      unfolding f_def apply (rule geod_dist3) using t inA by auto
    also have "... = abs(K t/2^(N t) * dist x0 y0 - K s/2^(N s) * dist x0 y0)"
      by (auto simp add: abs_mult_pos left_diff_distrib)
    also have "... = abs(t - s)"
      using t inA by auto
    finally show "dist (f s) (f t) = dist s t" unfolding dist_real_def by auto
  qed
  text ‹We can thus extend it to an isometry on the closure of dyadic points.
  It is the desired geodesic.›
  then obtain g where g: "isometry_on (closure A) g" "t. t  A  g t = f t"
    using isometry_extend_closure by metis
  have "isometry_on {0..dist x0 y0} g"
    by (rule isometry_on_subset[OF ‹isometry_on (closure A) g {0..dist x0 y0}  closure A])
  moreover have "g 0 = x0"
    using g(2)[OF 0  A] f 0 = x0 by simp
  moreover have "g (dist x0 y0) = y0"
    using g(2)[OF ‹dist x0 y0  A] f (dist x0 y0) = y0 by simp
  ultimately show ?thesis by auto
qed

end

text ‹We can now complete the proof that a complete space with middles is in fact geodesic:
all the work has been done in the locale \verb+complete_space_with_middle+, in Lemma~\verb+geod+.›

theorem complete_with_middles_imp_geodesic:
  assumes "x y::('a::complete_space). m. dist x m = dist x y /2  dist m y = dist x y /2"
  shows "OFCLASS('a, geodesic_space_class)"
proof (standard, rule geodesic_subsetI)
  fix x0 y0::'a
  interpret complete_space_with_middle x0 y0
    apply standard using assms by auto
  have "g. g 0 = x0  g (dist x0 y0) = y0  isometry_on {0..dist x0 y0} g"
    using geod by auto
  then show "G. geodesic_segment_between G x0 y0  G  UNIV"
    unfolding geodesic_segment_between_def by auto
qed


section ‹Quasi-isometries›

text ‹A $(\lambda, C)$ quasi-isometry is a function which behaves like an isometry, up to
an additive error $C$ and a multiplicative error $\lambda$. It can be very different from an
isometry on small scales (for instance, the function integer part is a quasi-isometry between
$\mathbb{R}$ and $\mathbb{Z}$), but on large scales it captures many important features of
isometries.

When the space is unbounded, one checks easily that $C \geq 0$ and $\lambda \geq 1$. As this
is the only case of interest (any two bounded sets are quasi-isometric), we incorporate
this requirement in the definition.›

definition quasi_isometry_on::"real  real  ('a::metric_space) set  ('a  ('b::metric_space))  bool"
  ("_ _ -quasi'_isometry'_on" [1000, 999])
  where "lambda C-quasi_isometry_on X f = ((lambda  1)  (C  0) 
    (x  X. y  X. (dist (f x) (f y)  lambda * dist x y + C  dist (f x) (f y)  (1/lambda) * dist x y - C)))"

abbreviation quasi_isometry :: "real  real  ('a::metric_space  'b::metric_space)  bool"
  ("_ _ -quasi'_isometry" [1000, 999])
  where "quasi_isometry lambda C f  lambda C-quasi_isometry_on UNIV f"

subsection ‹Basic properties of quasi-isometries›

lemma quasi_isometry_onD:
  assumes "lambda C-quasi_isometry_on X f"
  shows "x y. x  X  y  X  dist (f x) (f y)  lambda * dist x y + C"
        "x y. x  X  y  X  dist (f x) (f y)  (1/lambda) * dist x y - C"
        "lambda  1" "C  0"
using assms unfolding quasi_isometry_on_def by auto

lemma quasi_isometry_onI [intro]:
  assumes "x y. x  X  y  X  dist (f x) (f y)  lambda * dist x y + C"
          "x y. x  X  y  X  dist (f x) (f y)  (1/lambda) * dist x y - C"
          "lambda  1" "C  0"
  shows "lambda C-quasi_isometry_on X f"
using assms unfolding quasi_isometry_on_def by auto

lemma isometry_quasi_isometry_on:
  assumes "isometry_on X f"
  shows "1 0-quasi_isometry_on X f"
using assms unfolding isometry_on_def quasi_isometry_on_def by auto

lemma quasi_isometry_on_change_params:
  assumes "lambda C-quasi_isometry_on X f" "mu  lambda" "D  C"
  shows "mu D-quasi_isometry_on X f"
proof (rule quasi_isometry_onI)
  have P1: "lambda  1" "C  0" using quasi_isometry_onD[OF assms(1)] by auto
  then show P2: "mu  1" "D  0" using assms by auto
  fix x y assume inX: "x  X" "y  X"
  have "dist (f x) (f y)  lambda * dist x y + C"
    using quasi_isometry_onD[OF assms(1)] inX by auto
  also have "...  mu * dist x y + D"
    using assms by (auto intro!: mono_intros)
  finally show "dist (f x) (f y)  mu * dist x y + D" by simp
  have "dist (f x) (f y)  (1/lambda) * dist x y - C"
    using quasi_isometry_onD[OF assms(1)] inX by auto
  moreover have "(1/lambda) * dist x y + (- C)  (1/mu) * dist x y + (- D)"
    apply (intro mono_intros)
    using P1 P2 assms by (auto simp add: divide_simps)
  ultimately show "dist (f x) (f y)  (1/mu) * dist x y - D" by simp
qed

lemma quasi_isometry_on_subset:
  assumes "lambda C-quasi_isometry_on X f"
          "Y  X"
  shows "lambda C-quasi_isometry_on Y f"
using assms unfolding quasi_isometry_on_def by auto

lemma quasi_isometry_on_perturb:
  assumes "lambda C-quasi_isometry_on X f"
          "D  0"
          "x. x  X  dist (f x) (g x)  D"
  shows "lambda (C + 2 * D)-quasi_isometry_on X g"
proof (rule quasi_isometry_onI)
  show "lambda  1" "C + 2 * D  0" using D  0 quasi_isometry_onD[OF assms(1)] by auto
  fix x y assume *: "x  X" "y  X"
  have "dist (g x) (g y)  dist (f x) (f y) + 2 * D"
    using assms(3)[OF *(1)] assms(3)[OF *(2)] dist_triangle4[of "g x" "g y" "f x" "f y"] by (simp add: dist_commute)
  then show "dist (g x) (g y)  lambda * dist x y + (C + 2 * D)"
    using quasi_isometry_onD(1)[OF assms(1) *] by auto
  have "dist (g x) (g y)  dist (f x) (f y) - 2 * D"
    using assms(3)[OF *(1)] assms(3)[OF *(2)] dist_triangle4[of "f x" "f y" "g x" "g y"] by (simp add: dist_commute)
  then show "dist (g x) (g y)  (1/lambda) * dist x y - (C + 2 * D)"
    using quasi_isometry_onD(2)[OF assms(1) *] by auto
qed

lemma quasi_isometry_on_compose:
  assumes "lambda C-quasi_isometry_on X f"
          "mu D-quasi_isometry_on Y g"
          "f`X  Y"
  shows "(lambda * mu) (C * mu + D)-quasi_isometry_on X (g o f)"
proof (rule quasi_isometry_onI)
  have I: "lambda  1" "C  0" "mu  1" "D  0"
    using quasi_isometry_onD[OF assms(1)] quasi_isometry_onD[OF assms(2)] by auto
  then show "lambda * mu  1" "C * mu + D  0"
    by (auto, metis dual_order.order_iff_strict le_numeral_extra(2) mult_le_cancel_right1 order.strict_trans1)
  fix x y assume inX: "x  X" "y  X"
  then have inY: "f x  Y" "f y  Y" using f`X  Y by auto
  have "dist ((g o f) x) ((g o f) y)  mu * dist (f x) (f y) + D"
    using quasi_isometry_onD(1)[OF assms(2) inY] by simp
  also have "...  mu * (lambda * dist x y + C) + D"
    using mu  1 quasi_isometry_onD(1)[OF assms(1) inX] by auto
  finally show "dist ((g o f) x) ((g o f) y)  (lambda * mu) * dist x y + (C * mu + D)"
    by (auto simp add: algebra_simps)

  have "(1/(lambda * mu)) * dist x y - (C * mu + D)  (1/(lambda * mu)) * dist x y - (C/mu + D)"
    using mu  1 C  0 apply (auto, auto simp add: divide_simps)
    by (metis eq_iff less_eq_real_def mult.commute mult_eq_0_iff mult_le_cancel_right1 order.trans)
  also have "... = (1/mu) * ((1/lambda) * dist x y - C) - D"
    by (auto simp add: algebra_simps)
  also have "...  (1/mu) * dist (f x) (f y) - D"
    using mu  1 quasi_isometry_onD(2)[OF assms(1) inX] by (auto simp add: divide_simps)
  also have "...  dist ((g o f) x) ((g o f) y)"
    using quasi_isometry_onD(2)[OF assms(2) inY] by auto
  finally show "1 / (lambda * mu) * dist x y - (C * mu + D)  dist ((g  f) x) ((g  f) y)"
    by auto
qed

lemma quasi_isometry_on_bounded:
  assumes "lambda C-quasi_isometry_on X f"
          "bounded X"
  shows "bounded (f`X)"
proof (cases "X = {}")
  case True
  then show ?thesis by auto
next
  case False
  obtain x where "x  X" using False by auto
  obtain e where e: "z. z  X  dist x z  e"
    using bounded_any_center assms(2) by metis
  have "dist (f x) y  C + lambda * e" if "y  f`X" for y
  proof -
    obtain z where *: "z  X" "y = f z" using y  f`X by auto
    have "dist (f x) y  lambda * dist x z + C"
      unfolding y = f z using * quasi_isometry_onD(1)[OF assms(1) x  X z  X] by (auto simp add: add_mono)
    also have "...  C + lambda * e" using e[OF z  X] quasi_isometry_onD(3)[OF assms(1)] by auto
    finally show ?thesis by simp
  qed
  then show ?thesis unfolding bounded_def by auto
qed

lemma quasi_isometry_on_empty:
  assumes "C  0" "lambda  1"
  shows "lambda C-quasi_isometry_on {} f"
using assms unfolding quasi_isometry_on_def by auto

text ‹Quasi-isometries change the distance to a set by at most $\lambda \cdot + C$, this follows
readily from the fact that this inequality holds pointwise.›

lemma quasi_isometry_on_infdist:
  assumes "lambda C-quasi_isometry_on X f"
          "w  X"
          "S  X"
  shows "infdist (f w) (f`S)  lambda * infdist w S + C"
        "infdist (f w) (f`S)  (1/lambda) * infdist w S - C"
proof -
  have "lambda  1" "C  0" using quasi_isometry_onD[OF assms(1)] by auto
  show "infdist (f w) (f`S)  lambda * infdist w S + C"
  proof (cases "S = {}")
    case True
    then show ?thesis
      using C  0 unfolding infdist_def by auto
  next
    case False
    then have "(INF xS. dist (f w) (f x))  (INF xS. lambda * dist w x + C)"
      apply (rule cINF_superset_mono)
        apply (meson bdd_belowI2 zero_le_dist) using assms by (auto intro!: quasi_isometry_onD(1)[OF assms(1)])
    also have "... = (INF t(dist w)`S. lambda * t + C)"
      by (auto simp add: image_comp)
    also have "... = lambda * Inf ((dist w)`S) + C"
      apply (rule continuous_at_Inf_mono[symmetric])
      unfolding mono_def using lambda  1 False by (auto intro!: continuous_intros)
    finally show ?thesis unfolding infdist_def using False by (auto simp add: image_comp)
  qed
  show "1 / lambda * infdist w S - C  infdist (f w) (f ` S)"
  proof (cases "S = {}")
    case True
    then show ?thesis
      using C  0 unfolding infdist_def by auto
  next
    case False
    then have "(1/lambda) * infdist w S - C = (1/lambda) * Inf ((dist w)`S) - C"
      unfolding infdist_def by auto
    also have "... = (INF t(dist w)`S. (1/lambda) * t - C)"
      apply (rule continuous_at_Inf_mono)
      unfolding mono_def using lambda  1 False by (auto simp add: divide_simps intro!: continuous_intros)
    also have "... = (INF xS. (1/lambda) * dist w x - C)"
      by (auto simp add: image_comp)
    also have "...  (INF xS. dist (f w) (f x))"
      apply (rule cINF_superset_mono[OF False]) apply (rule bdd_belowI2[of _ "-C"])
      using assms lambda  1 apply simp apply simp apply (rule quasi_isometry_onD(2)[OF assms(1)])
      using assms by auto
    finally show ?thesis unfolding infdist_def using False by (auto simp add: image_comp)
  qed
qed

subsection ‹Quasi-isometric isomorphisms›

text ‹The notion of isomorphism for quasi-isometries is not that it should be a bijection, as it is
a coarse notion, but that it is a bijection up to a bounded displacement. For instance, the
inclusion of $\mathbb{Z}$ in $\mathbb{R}$ is a quasi-isometric isomorphism between these spaces,
whose (quasi)-inverse (which is non-unique) is given by the function integer part. This is
formalized in the next definition.›

definition quasi_isometry_between::"real  real  ('a::metric_space) set  ('b::metric_space) set  ('a  'b)  bool"
  ("_ _ -quasi'_isometry'_between" [1000, 999])
  where "lambda C-quasi_isometry_between X Y f = ((lambda C-quasi_isometry_on X f)  (f`X  Y)  (yY. xX. dist (f x) y  C))"

definition quasi_isometric::"('a::metric_space) set  ('b::metric_space) set  bool"
  where "quasi_isometric X Y = (lambda C f. lambda C-quasi_isometry_between X Y f)"

lemma quasi_isometry_betweenD:
  assumes "lambda C-quasi_isometry_between X Y f"
  shows "lambda C-quasi_isometry_on X f"
        "f`X  Y"
        "y. y  Y  xX. dist (f x) y  C"
        "x y. x  X  y  X  dist (f x) (f y)  lambda * dist x y + C"
        "x y. x  X  y  X  dist (f x) (f y)  (1/lambda) * dist x y - C"
        "lambda  1" "C  0"
using assms unfolding quasi_isometry_between_def quasi_isometry_on_def by auto

lemma quasi_isometry_betweenI:
  assumes "lambda C-quasi_isometry_on X f"
          "f`X  Y"
          "y. y  Y  xX. dist (f x) y  C"
  shows "lambda C-quasi_isometry_between X Y f"
using assms unfolding quasi_isometry_between_def by auto

lemma quasi_isometry_on_between:
  assumes "lambda C-quasi_isometry_on X f"
  shows "lambda C-quasi_isometry_between X (f`X) f"
using assms unfolding quasi_isometry_between_def quasi_isometry_on_def by force

lemma quasi_isometry_between_change_params:
  assumes "lambda C-quasi_isometry_between X Y f" "mu  lambda" "D  C"
  shows "mu D-quasi_isometry_between X Y f"
proof (rule quasi_isometry_betweenI)
  show "mu D-quasi_isometry_on X f"
    by (rule quasi_isometry_on_change_params[OF quasi_isometry_betweenD(1)[OF assms(1)] assms(2) assms(3)])
  show "f`X  Y" using quasi_isometry_betweenD[OF assms(1)] by auto
  fix y assume "y  Y"
  show "xX. dist (f x) y  D" using quasi_isometry_betweenD(3)[OF assms(1) y  Y] D  C by force
qed

lemma quasi_isometry_subset:
  assumes "X  Y" "y. y  Y  xX. dist x y  C" "C  0"
  shows "1 C-quasi_isometry_between X Y (λx. x)"
unfolding quasi_isometry_between_def using assms by auto

lemma isometry_quasi_isometry_between:
  assumes "isometry f"
  shows "1 0-quasi_isometry_between UNIV UNIV f"
using assms unfolding quasi_isometry_between_def quasi_isometry_on_def isometry_def isometry_on_def surj_def by (auto) metis

proposition quasi_isometry_inverse:
  assumes "lambda C-quasi_isometry_between X Y f"
  shows "g. lambda (3 * C * lambda)-quasi_isometry_between Y X g
           (xX. dist x (g (f x))  3 * C * lambda)
           (yY. dist y (f (g y))  3 * C * lambda)"
proof -
  define g where "g = (λy. SOME x. x  X  dist (f x) y  C)"
  have *: "g y  X  dist (f (g y)) y  C" if "y  Y" for y
    unfolding g_def using quasi_isometry_betweenD(3)[OF assms that] by (metis (no_types, lifting) someI_ex)
  have "lambda  1" "C  0" using quasi_isometry_betweenD[OF assms] by auto

  have "C  3 * C * lambda" using lambda  1 C  0
    by (simp add: algebra_simps mult_ge1_mono)
  then have A: "dist y (f (g y))  3 * C * lambda" if "y  Y" for y
    using *[OF that] by (simp add: dist_commute)

  have B: "dist x (g (f x))  3 * C * lambda" if "x  X" for x
  proof -
    have "f x  Y" using that quasi_isometry_betweenD(2)[OF assms] by auto
    have "(1/lambda) * dist x (g (f x)) - C  dist (f x) (f (g (f x)))"
      apply (rule quasi_isometry_betweenD(5)[OF assms]) using that *[OF f x  Y] by auto
    also have "...  C" using *[OF f x  Y] by (simp add: dist_commute)
    finally have "dist x (g (f x))  2 * C * lambda"
      using lambda  1 C  0 by (simp add: divide_simps)
    also have "...  3 * C * lambda"
      using lambda  1 C  0 by (simp add: divide_simps)
    finally show ?thesis by auto
  qed

  have "lambda (3 * C * lambda)-quasi_isometry_on Y g"
  proof (rule quasi_isometry_onI)
    show "lambda  1" "3 * C * lambda  0" using lambda  1 C  0 by auto
    fix y1 y2 assume inY: "y1  Y" "y2  Y"
    then have inX: "g y1  X" "g y2  X" using * by auto
    have "dist y1 y2  dist y1 (f (g y1)) + dist (f (g y1)) (f (g y2)) + dist (f (g y2)) y2"
      using dist_triangle4 by auto
    also have "...  C + dist (f (g y1)) (f (g y2)) + C"
      using *[OF inY(1)] *[OF inY(2)] by (auto simp add: dist_commute intro: add_mono)
    also have "...  C + (lambda * dist (g y1) (g y2) + C) + C"
      using quasi_isometry_betweenD(4)[OF assms inX] by (auto intro: add_mono)
    finally have "dist y1 y2 - 3 * C  lambda * dist (g y1) (g y2)" by auto
    then have "dist (g y1) (g y2)  (1/lambda) * dist y1 y2 - 3 * C / lambda"
      using lambda  1 by (auto simp add: divide_simps mult.commute)
    moreover have "3 * C / lambda  3 * C * lambda"
      using lambda  1 C  0 apply (auto simp add: divide_simps mult_le_cancel_left1)
      by (metis dual_order.order_iff_strict less_1_mult mult.left_neutral)
    ultimately show "dist (g y1) (g y2)  (1/lambda) * dist y1 y2 - 3 * C * lambda"
      by auto

    have "(1/lambda) * dist (g y1) (g y2) - C  dist (f (g y1)) (f (g y2))"
      using quasi_isometry_betweenD(5)[OF assms inX] by auto
    also have "...  dist (f (g y1)) y1 + dist y1 y2 + dist y2 (f (g y2))"
      using dist_triangle4 by auto
    also have "...  C + dist y1 y2 + C"
      using *[OF inY(1)] *[OF inY(2)] by (auto simp add: dist_commute intro: add_mono)
    finally show "dist (g y1) (g y2)  lambda * dist y1 y2 + 3 * C * lambda"
      using lambda  1 by (auto simp add: divide_simps algebra_simps)
  qed
  then have "lambda (3 * C * lambda)-quasi_isometry_between Y X g"
  proof (rule quasi_isometry_betweenI)
    show "g ` Y  X" using * by auto
    fix x assume "x  X"
    have "f x  Y" "dist (g (f x)) x  3 * C * lambda"
      using B[OF x  X] quasi_isometry_betweenD(2)[OF assms] x  X by (auto simp add: dist_commute)
    then show "yY. dist (g y) x  3 * C * lambda" by blast
  qed
  then show ?thesis using A B by blast
qed

proposition quasi_isometry_compose:
  assumes "lambda C-quasi_isometry_between X Y f"
          "mu D-quasi_isometry_between Y Z g"
  shows "(lambda * mu) (C * mu + 2 * D)-quasi_isometry_between X Z (g o f)"
proof (rule quasi_isometry_betweenI)
  have "(lambda * mu) (C * mu + D)-quasi_isometry_on X (g  f)"
    by (rule quasi_isometry_on_compose[OF quasi_isometry_betweenD(1)[OF assms(1)]
        quasi_isometry_betweenD(1)[OF assms(2)] quasi_isometry_betweenD(2)[OF assms(1)]])
  then show "(lambda * mu) (C * mu + 2 * D)-quasi_isometry_on X (g  f)"
    apply (rule quasi_isometry_on_change_params) using quasi_isometry_betweenD(7)[OF assms(2)] by auto

  show "(g  f) ` X  Z"
    using quasi_isometry_betweenD(2)[OF assms(1)] quasi_isometry_betweenD(2)[OF assms(2)]
    by auto
  fix z assume "z  Z"
  obtain y where y: "y  Y" "dist (g y) z  D"
    using quasi_isometry_betweenD(3)[OF assms(2) z  Z] by auto
  obtain x where x: "x  X" "dist (f x) y  C"
    using quasi_isometry_betweenD(3)[OF assms(1) y  Y] by auto
  have "dist ((g o f) x) z  dist (g (f x)) (g y) + dist (g y) z"
    using dist_triangle by auto
  also have "...  (mu * dist (f x) y + D) + D"
    apply (rule add_mono, rule quasi_isometry_betweenD(4)[OF assms(2)])
    using x y quasi_isometry_betweenD(2)[OF assms(1)] by auto
  also have "...  C * mu + 2 * D"
    using x(2) quasi_isometry_betweenD(6)[OF assms(2)] by auto
  finally show "xX. dist ((g  f) x) z  C * mu + 2 * D"
    using x(1) by auto
qed

theorem quasi_isometric_equiv_rel:
  "quasi_isometric X X"
  "quasi_isometric X Y  quasi_isometric Y Z  quasi_isometric X Z"
  "quasi_isometric X Y  quasi_isometric Y X"
proof -
  show "quasi_isometric X X"
    unfolding quasi_isometric_def using quasi_isometry_subset[of X X 0] by auto
  assume H: "quasi_isometric X Y"
  then show "quasi_isometric Y X"
    unfolding quasi_isometric_def using quasi_isometry_inverse by blast
  assume "quasi_isometric Y Z"
  then show "quasi_isometric X Z"
    using H unfolding quasi_isometric_def using quasi_isometry_compose by blast
qed

text ‹Many interesting properties in geometric group theory are invariant under quasi-isometry.
We prove the most basic ones here.›

lemma quasi_isometric_empty:
  assumes "X = {}" "quasi_isometric X Y"
  shows "Y = {}"
using assms unfolding quasi_isometric_def quasi_isometry_between_def quasi_isometry_on_def by blast

lemma quasi_isometric_bounded:
  assumes "bounded X" "quasi_isometric X Y"
  shows "bounded Y"
proof (cases "X = {}")
  case True
  show ?thesis using quasi_isometric_empty[OF True assms(2)] by auto
next
  case False
  obtain lambda C f where QI: "lambda C-quasi_isometry_between X Y f"
    using assms(2) unfolding quasi_isometric_def by auto
  obtain x where "x  X" using False by auto
  obtain e where e: "z. z  X  dist x z  e"
    using bounded_any_center assms(1) by metis
  have "dist (f x) y  2 * C + lambda * e" if "y  Y" for y
  proof -
    obtain z where *: "z  X" "dist (f z) y  C"
      using quasi_isometry_betweenD(3)[OF QI y  Y] by auto
    have "dist (f x) y  dist (f x) (f z) + dist (f z) y" using dist_triangle by auto
    also have "...  (lambda * dist x z + C) + C"
      using * quasi_isometry_betweenD(4)[OF QI x  X z  X] by (auto simp add: add_mono)
    also have "...  2 * C + lambda * e"
      using quasi_isometry_betweenD(6)[OF QI] e[OF z  X] by (auto simp add: algebra_simps)
    finally show ?thesis by simp
  qed
  then show ?thesis unfolding bounded_def by auto
qed

lemma quasi_isometric_bounded_iff:
  assumes "bounded X" "X  {}" "bounded Y" "Y  {}"
  shows "quasi_isometric X Y"
proof -
  obtain x y where "x  X" "y  Y" using assms by auto
  obtain C where C: "z. z  Y  dist y z  C"
    using ‹bounded Y bounded_any_center by metis
  have "C  0" using C[OF y  Y] by auto
  obtain D where D: "z. z  X  dist x z  D"
    using ‹bounded X bounded_any_center by metis
  have "D  0" using D[OF x  X] by auto

  define f::"'a  'b" where "f = (λ_. y)"
  have "1 (C + 2 * D)-quasi_isometry_between X Y f"
  proof (rule quasi_isometry_betweenI)
    show "f`X  Y" unfolding f_def using y  Y by auto
    show "1 (C + 2 * D)-quasi_isometry_on X f"
    proof (rule quasi_isometry_onI, auto simp add: C  0 D  0 f_def)
      fix a b assume "a  X" "b  X"
      have "dist a b  dist a x + dist x b"
        using dist_triangle by auto
      also have "...  D + D"
        using D[OF a  X] D[OF b  X] by (auto simp add: dist_commute)
      finally show "dist a b  C + 2 * D" using C  0 by auto
    qed
    show "aX. dist (f a) z  C + 2 * D" if "z  Y" for z
      unfolding f_def using x  X C[OF z  Y] D  0 by auto
  qed
  then show ?thesis unfolding quasi_isometric_def by auto
qed

subsection ‹Quasi-isometries of Euclidean spaces.›

text ‹A less trivial fact is that the dimension of euclidean spaces is invariant under
quasi-isometries. It is proved below using growth argument, as quasi-isometries preserve the
growth rate.

The growth of the space is asymptotic behavior of the number of well-separated points that
fit in a ball of radius $R$, when $R$ tends to infinity. Up to a suitable equivalence, it is
clearly a quasi-isometry invariance. We show below that, in a Euclidean space of dimension $d$,
the growth is like $R^d$: the upper bound is obtained by using the fact that we have disjoint balls
inside a big ball, hence volume controls conclude the argument, while the lower bound is obtained
by considering integer points.›

text ‹First, we show that the growth rate of a Euclidean space of dimension $d$ is bounded
from above by $R^d$, using the control on measure of disjoint balls and a volume argument.›

proposition growth_rate_euclidean_above:
  fixes D::real
  assumes "D > (0::real)"
      and H: "F  cball (0::'a::euclidean_space) R" "R  0"
          "x y. x  F  y  F  x  y  dist x y  D"
  shows "finite F  card F  1 + ((6/D)^(DIM('a))) * R^(DIM('a))"
proof -
  define C::real where "C = ((6/D)^(DIM('a)))"
  have "C  0" unfolding C_def using D > 0 by auto
  have "D/3  0" using assms by auto
  have "finite F  card F  1 + C * R^(DIM('a))"
  proof (cases "R < D/2")
    case True
    have "x = y" if "x  F" "y  F" for x y
    proof (rule ccontr)
      assume "¬(x = y)"
      then have "D  dist x y" using H x  F y  F by auto
      also have "...  dist x 0 + dist 0 y" by (rule dist_triangle)
      also have "...  R + R"
        using H(1) x  F y  F by (intro add_mono, auto)
      also have "... < D" using R < D/2 by auto
      finally show False by simp
    qed
    then have "finite F  card F  1" using finite_at_most_singleton by auto
    moreover have "1 + 0 * R^(DIM('a))  1 + C * R^(DIM('a))"
      using C  0 R  0 by (auto intro: mono_intros)
    ultimately show ?thesis by auto
  next
    case False
    have "card G  1 + C * R^(DIM('a))" if "G  F" "finite G" for G
    proof -
      have "norm y  2*R" if "y  cball x (D/3)" "x  G" for x y
      proof -
        have "norm y = dist 0 y" by auto
        also have "...  dist 0 x + dist x y" by (rule dist_triangle)
        also have "...  R + D/3"
          using x  G G  F y  cball x (D/3) F  cball 0 R by (auto intro: add_mono)
        finally show ?thesis using False D > 0 by auto
      qed
      then have I: "(xG. cball x (D/3))  cball 0 (2*R)"
        by auto
      have "disjoint_family_on (λx. cball x (D/3)) G"
        unfolding disjoint_family_on_def proof (auto)
        fix a b x assume *: "a  G" "b  G" "a  b" "dist a x * 3  D" "dist b x * 3  D"
        then have "D  dist a b" using H G  F by auto
        also have "...  dist a x + dist x b" by (rule dist_triangle)
        also have "...  D/3 + D/3"
          using * by (auto simp add: dist_commute intro: mono_intros)
        also have "... < D" using D > 0 by auto
        finally show False by simp
      qed

      have "2 * R  0" using R  0 by auto
      define A where "A = measure lborel (cball (0::'a) 1)"
      have "A > 0" unfolding A_def using lebesgue_measure_ball_pos by auto
      have "card G * ((D/3)^(DIM('a)) * A) = (xG. ((D/3)^(DIM('a)) * A))"
        by auto
      also have "... = (xG. measure lborel (cball x (D/3)))"
        unfolding lebesgue_measure_ball[OF D/3  0] A_def by auto
      also have "... = measure lborel (xG. cball x (D/3))"
        apply (rule measure_finite_Union[symmetric, OF ‹finite G _ ‹disjoint_family_on (λx. cball x (D/3)) G])
        apply auto using emeasure_bounded_finite less_imp_neq by auto
      also have "...  measure lborel (cball (0::'a) (2*R))"
        apply (rule measure_mono_fmeasurable) using I ‹finite G emeasure_bounded_finite
        unfolding fmeasurable_def by auto
      also have "... = (2*R)^(DIM('a)) * A"
        unfolding A_def using lebesgue_measure_ball[OF 2*R  0] by auto
      finally have "card G * (D/3)^(DIM('a))  (2*R)^(DIM('a))"
        using A > 0 by (auto simp add: divide_simps)
      then have "card G  C * R^(DIM('a))"
        unfolding C_def using D > 0 apply (auto simp add: algebra_simps divide_simps)
        by (metis numeral_times_numeral power_mult_distrib semiring_norm(12) semiring_norm(14))
      then show ?thesis by auto
    qed
    then show "finite F  card F  1 + C * R^(DIM('a))"
      by (rule finite_finite_subset_caract')
  qed
  then show ?thesis unfolding C_def by blast
qed

text ‹Then, we show that the growth rate of a Euclidean space of dimension $d$ is bounded
from below by $R^d$, using integer points.›

proposition growth_rate_euclidean_below:
  fixes D::real
  assumes "R  0"
  shows "F. (F  cball (0::'a::euclidean_space) R
             (xF. yF. x = y  dist x y  D)  finite F  card F  (1/((max D 1) * DIM('a)))^(DIM('a)) * R^(DIM('a)))"
proof -
  define E where "E = max D 1"
  have "E > 0" unfolding E_def by auto
  define c where "c = (1/(E * DIM('a)))^(DIM('a))"
  have "c > 0" unfolding c_def using E > 0 by auto

  define n where "n = nat (floor (R/(E * DIM('a)))) + 1"
  then have "n > 0" using R  0 by auto

  have "R/(E * DIM('a))  n" unfolding n_def by linarith
  then have "c * R^(DIM('a))  n^(DIM('a))"
    unfolding c_def power_mult_distrib[symmetric] by (auto simp add: 0 < E 0  R less_imp_le power_mono)
  have "n-1  R/(E * DIM('a))"
    unfolding n_def using R  0 E > 0 by auto
  then have "E * DIM('a) * (n-1)  R"
    using R  0 E > 0 by (simp add: mult.commute pos_le_divide_eq)

  text ‹We want to consider the set of linear combinations of basis elements with integer
  coefficients bounded by $n$ (multiplied by $E$ to guarantee the $D$ separation).
  The formal way to write these elements is to consider all
  the functions from the basis to $\{0,\dotsc, n-1\}$, and associate to such a function
  $f$ the point $\sum E f(i) \cdot i$ where the sum is over all basis elements $i$. This is
  what the next definition does.›
  define F::"'a set" where "F = (λf. (iBasis. (E * real (f i)) *R i))`((Basis::('a set)) E {0..<n})"

  have "f = g" if "f  (Basis::('a set)) E {0..<n}" "g  Basis E {0..<n}"
                  "(iBasis. (E * real (f i)) *R i) = (iBasis. (E * real (g i)) *R i)" for f g
  proof (rule ext)
    fix i show "f i = g i"
    proof (cases "i  Basis")
      case True
      then have "E * real(f i) = E * real(g i)"
        using inner_sum_left_Basis[OF True, of "λi. E * real(f i)"] inner_sum_left_Basis[OF True, of "λi. E * real(g i)"] that(3)
        by auto
      then show "f i = g i" using E > 0 by auto
    next
      case False
      then have "f i = undefined" "g i = undefined" using that by auto
      then show "f i = g i" by auto
    qed
  qed
  then have "inj_on (λf. (iBasis. (E * real (f i)) *R i)) ((Basis::('a set)) E {0..<n})"
    by (simp add: inj_onI)
  then have "card F = card ((Basis::('a set)) E {0..<n})" unfolding F_def
    using card_image by blast
  also have "... = n^(DIM('a))"
    unfolding card_PiE[OF finite_Basis] by (auto simp add: prod_constant)
  finally have "card F = n^(DIM('a))" by auto
  then have "finite F" using n > 0
    using card.infinite by force
  have "card F  c * R^(DIM('a))"
    using c * R^(DIM('a))  n^(DIM('a)) ‹card F = n^(DIM('a)) by auto

  have separation: "dist x y  D" if "x  F" "y  F" "x  y" for x y
  proof -
    obtain f where x: "f  (Basis::('a set)) E {0..<n}" "x = (iBasis. (E * real (f i)) *R i)"
      using x  F unfolding F_def by auto
    obtain g where y: "g  (Basis::('a set)) E {0..<n}" "y = (iBasis. (E * real (g i)) *R i)"
      using y  F unfolding F_def by auto
    obtain i where "f i  g i" using x y x y by force
    moreover have "f j = g j" if "j  Basis" for j
      using x(1) y(1) that by fastforce
    ultimately have "i  Basis" by auto
    have "D  E" unfolding E_def by auto
    also have "...  abs(E * (real (f i) - real (g i)))" using E > 0
      using f i  g i by (auto simp add: divide_simps abs_mult)
    also have "... = abs(inner x i - inner y i)"
      unfolding x(2) y(2) inner_sum_left_Basis[OF i  Basis›] by (auto simp add: algebra_simps)
    also have "... = abs(inner (x-y) i)"
      by (simp add: inner_diff_left)
    also have "...  norm (x-y)" using Basis_le_norm[OF i  Basis›] by blast
    finally show "dist x y  D" by (simp add: dist_norm)
  qed

  have "norm x  R" if "x  F" for x
  proof -
    obtain f where x: "f  (Basis::('a set)) E {0..<n}" "x = (iBasis. (E * real (f i)) *R i)"
      using x  F unfolding F_def by auto
    then have "norm x = norm (iBasis. (E * real (f i)) *R i)" by simp
    also have "...  (iBasis. norm((E * real (f i)) *R i))"
      by (rule norm_sum)
    also have "... = (iBasis. abs(E * real (f i)))" by auto
    also have "... = (iBasis. E * real (f i))" using E > 0 by auto
    also have "...  (i(Basis::'a set). E * (n-1))"
      apply (rule sum_mono) using PiE_mem[OF x(1)] E > 0 apply (auto simp add: divide_simps)
      using n > 0 by fastforce
    also have "... = DIM('a) * E * (n-1)"
      by auto
    finally show "norm x  R" using E * DIM('a) * (n-1)  R by (auto simp add: algebra_simps)
  qed
  then have "F  cball 0 R" by auto
  then show ?thesis using ‹card F  c * R^(DIM('a)) ‹finite F separation c_def E_def by blast
qed

text ‹As the growth is invariant under quasi-isometries, we deduce that it is impossible
to map quasi-isometrically a Euclidean space in a space of strictly smaller dimension.›

proposition quasi_isometry_on_euclidean:
  fixes f::"'a::euclidean_space'b::euclidean_space"
  assumes "lambda C-quasi_isometry_on UNIV f"
  shows "DIM('a)  DIM('b)"
proof -
  have C: "lambda  1" "C  0" using quasi_isometry_onD[OF assms] by auto
  define D where "D = lambda * (C+1)"
  define Ca where "Ca = (1/((max D 1) * DIM('a)))^(DIM('a))"
  have "Ca > 0" unfolding Ca_def by auto
  have A: "R::real. R  0  (F. (F  cball (0::'a::euclidean_space) R
         (xF. yF. x = y  dist x y  D)  finite F  card F  Ca * R^(DIM('a))))"
    using growth_rate_euclidean_below[of _ D] unfolding Ca_def by blast
  define Cb::real where "Cb = ((6/1)^(DIM('b)))"
  have B: "F (R::real). (F  cball (0::'b::euclidean_space) R  R  0  (xF. yF. x = y  dist x y  1)  (finite F  card F  1 + Cb * R^(DIM('b))))"
    using growth_rate_euclidean_above[of 1] unfolding Cb_def by fastforce

  have M: "Ca * R^(DIM('a))  1 + Cb * (lambda * R + C + norm(f 0))^(DIM('b))" if "R  0" for R::real
  proof -
    obtain F::"'a set" where F: "F  cball 0 R" "xF. yF. x = y  dist x y  D"
                                "finite F" "card F  Ca * R^(DIM('a))"
      using A[OF R  0] by auto
    define G where "G = f`F"
    have *: "dist (f x) (f y)  1" if "x  y" "x  F" "y  F" for x y
    proof -
      have "dist x y  D" using that F(2) by auto
      have "1 = (1/lambda) * D - C" using lambda  1 unfolding D_def by auto
      also have "...  (1/lambda) * dist x y - C"
        using ‹dist x y  D lambda  1 by (auto simp add: divide_simps)
      also have "...  dist (f x) (f y)"
        using quasi_isometry_onD[OF assms] by auto
      finally show ?thesis by simp
    qed
    then have "inj_on f F" unfolding inj_on_def by force
    then have "card G = card F" unfolding G_def by (simp add: card_image)
    then have "card G  Ca * R^(DIM('a))" using F by auto

    moreover have "finite G  card G  1 + Cb * (lambda * R + C + norm(f 0))^(DIM('b))"
    proof (rule B)
      show "0  lambda * R + C + norm (f 0)" using R  0 C  0 lambda  1 by auto
      show "xG. yG. x = y  1  dist x y" using * unfolding G_def by (auto, metis)
      show "G  cball 0 (lambda * R + C + norm (f 0))"
      unfolding G_def proof (auto)
        fix x assume "x  F"
        have "norm (f x)  norm (f 0) + dist (f x) (f 0)"
          by (metis dist_0_norm dist_triangle2)
        also have "...  norm (f 0) + (lambda * dist x 0 + C)"
          by (intro mono_intros quasi_isometry_onD(1)[OF assms]) auto
        also have "...  norm (f 0) + lambda * R + C"
          using x  F F  cball 0 R lambda  1 by auto
        finally show "norm (f x)  lambda * R + C + norm (f 0)" by auto
      qed
    qed
    ultimately show "Ca * R^(DIM('a))  1 + Cb * (lambda * R + C + norm(f 0))^(DIM('b))"
      by auto
  qed
  define CB where "CB = max Cb 0"
  have "CB  0" "CB  Cb" unfolding CB_def by auto
  define D::real where "D = (1 + CB * (lambda + C + norm(f 0))^(DIM('b)))/Ca"
  have Rineq: "R^(DIM('a))  D * R^(DIM('b))" if "R  1" for R::real
  proof -
    have "Ca * R^(DIM('a))  1 + Cb * (lambda * R + C + norm(f 0))^(DIM('b))"
      using M R  1 by auto
    also have "...  1 + CB * (lambda * R + C + norm(f 0))^(DIM('b))"
      using CB  Cb lambda  1 R  1 C  0 by (auto intro!: mult_right_mono)
    also have "...  R^(DIM('b)) + CB * (lambda * R + C * R + norm(f 0) * R)^(DIM('b))"
      using lambda  1 R  1 C  0 CB  0 by (auto intro!: mono_intros)
    also have "... = (1 + CB * (lambda + C + norm(f 0))^(DIM('b))) * R^(DIM('b))"
      by (auto simp add: algebra_simps power_mult_distrib[symmetric])
    finally show ?thesis
      using Ca > 0 unfolding D_def by (auto simp add: divide_simps algebra_simps)
  qed
  show "DIM('a)  DIM('b)"
  proof (rule ccontr)
    assume "¬(DIM('a)  DIM('b))"
    then obtain n where "DIM('a) = DIM('b) + n" "n > 0"
      by (metis less_imp_add_positive not_le)
    have "D  1" using Rineq[of 1] by auto
    define R where "R = 2 * D"
    then have "R  1" using D  1 by auto
    have "R^n * R^(DIM('b)) = R^(DIM('a))"
      unfolding DIM('a) = DIM('b) + n by (auto simp add: power_add)
    also have "...  D * R^(DIM('b))" using Rineq[OF R  1] by auto
    finally have "R^n  D" using R  1 by auto
    moreover have "2 * D  R^n" unfolding R_def using D  1 n > 0
      by (metis One_nat_def Suc_leI 1  R R  2 * D less_eq_real_def power_increasing_iff power_one power_one_right)
    ultimately show False using D  1 by auto
  qed
qed

text ‹As a particular case, we deduce that two quasi-isometric Euclidean spaces have the
same dimension.›

theorem quasi_isometric_euclidean:
  assumes "quasi_isometric (UNIV::'a::euclidean_space set) (UNIV::'b::euclidean_space set)"
  shows "DIM('a) = DIM('b)"
proof -
  obtain lambda C and f::"'a 'b" where "lambda C-quasi_isometry_on UNIV f"
    using assms unfolding quasi_isometric_def quasi_isometry_between_def by auto
  then have *: "DIM('a)  DIM('b)" using quasi_isometry_on_euclidean by auto

  have "quasi_isometric (UNIV::'b::euclidean_space set) (UNIV::'a::euclidean_space set)"
    using quasi_isometric_equiv_rel(3)[OF assms] by auto
  then obtain lambda C and f::"'b 'a" where "lambda C-quasi_isometry_on UNIV f"
    unfolding quasi_isometric_def quasi_isometry_between_def by auto
  then have "DIM('b)  DIM('a)" using quasi_isometry_on_euclidean by auto
  then show ?thesis using * by auto
qed

text ‹A different (and important) way to prove the above statement would be to use asymptotic
cones. Here, it can be done in an elementary way: start with a quasi-isometric map $f$, and
consider a limit (defined with a ultrafilter) of $x\mapsto f(n x)/n$. This is a map which
contracts and expands the distances by at most $\lambda$. In particular, it is a homeomorphism
on its image. No such map exists if the dimension of the target is smaller than the dimension
of the source (invariance of domain theorem, already available in the library).

The above argument using growth is more elementary to write, though.›


subsection ‹Quasi-geodesics›

text ‹A quasi-geodesic is a quasi-isometric embedding of a real segment into a metric space. As the
embedding need not be continuous, a quasi-geodesic does not have to be compact, nor connected, which
can be a problem. However, in a geodesic space, it is always possible to deform a quasi-geodesic
into a continuous one (at the price of worsening the quasi-isometry constants). This is the content
of the proposition \verb+quasi_geodesic_made_lipschitz+ below, which is a variation around Lemma
III.H.1.11 in~\cite{bridson_haefliger}. The strategy of the proof is simple: assume that the
quasi-geodesic $c$ is defined on $[a,b]$. Then, on the points $a$, $a+C/\lambda$, $\cdots$,
$a+ N \cdot C/\lambda$, $b$, take $d$ equal to $c$, where $N$ is chosen so that the distance
between the last point and $b$ is in $[C/\lambda, 2C/\lambda)$. In the intervals, take $d$ to
be geodesic.›

proposition (in geodesic_space) quasi_geodesic_made_lipschitz:
  fixes c::"real  'a"
  assumes "lambda C-quasi_isometry_on {a..b} c" "dist (c a) (c b)  2 * C"
  shows "d. continuous_on {a..b} d  d a = c a  d b = c b
               (x{a..b}. dist (c x) (d x)  4 * C)
               lambda (4 * C)-quasi_isometry_on {a..b} d
               (2 * lambda)-lipschitz_on {a..b} d
               hausdorff_distance (c`{a..b}) (d`{a..b})  2 * C"
proof -
  consider "C = 0" | "C > 0  b  a" | "C > 0  a < b  b  a + 2 * C/lambda" | "C > 0  a +2 * C/lambda < b"
    using quasi_isometry_onD(4)[OF assms(1)] by fastforce
  then show ?thesis
  proof (cases)
    text ‹If the original function is Lipschitz, we can use it directly.›
    case 1
    have "lambda-lipschitz_on {a..b} c"
      apply (rule lipschitz_onI) using 1 quasi_isometry_onD[OF assms(1)] by auto
    then have a: "(2 * lambda)-lipschitz_on {a..b} c"
      apply (rule lipschitz_on_mono) using quasi_isometry_onD[OF assms(1)] assms by (auto simp add: divide_simps)
    then have b: "continuous_on {a..b} c"
      using lipschitz_on_continuous_on by blast
    have "continuous_on {a..b} c  c a = c a  c b = c b
                 (x{a..b}. dist (c x) (c x)  4 * C)
                 lambda (4 * C)-quasi_isometry_on {a..b} c
                 (2 * lambda)-lipschitz_on {a..b} c
                 hausdorff_distance (c`{a..b}) (c`{a..b})  2 * C"
      using 1 a b assms(1) by auto
    then show ?thesis by blast
  next
    text ‹If the original interval is empty, anything will do.›
    case 2
    then have "b < a" using assms(2) less_eq_real_def by auto
    then have *: "{a..b} = {}" by auto
    have a: "(2 * lambda)-lipschitz_on {a..b} c"
      unfolding * apply (rule lipschitz_intros) using quasi_isometry_onD[OF assms(1)] assms by (auto simp add: divide_simps)
    then have b: "continuous_on {a..b} c"
      using lipschitz_on_continuous_on by blast
    have "continuous_on {a..b} c  c a = c a  c b = c b
                 (x{a..b}. dist (c x) (c x)  4 * C)
                 lambda (4 * C)-quasi_isometry_on {a..b} c
                 (2 * lambda)-lipschitz_on {a..b} c
                 hausdorff_distance (c`{a..b}) (c`{a..b})  2 * C"
      using a b quasi_isometry_on_empty assms(1) quasi_isometry_onD[OF assms(1)] * assms by auto
    then show ?thesis by blast
  next
    text ‹If the original interval is short, we can use a direct geodesic interpolation between
    its endpoints›
    case 3
    then have C: "C > 0" "lambda  1" using quasi_isometry_onD[OF assms(1)] by auto
    have [mono_intros]: "1/lambda  lambda" using C by (simp add: divide_simps mult_ge1_powers(1))
    have "a < b" using 3 by simp
    have "2 * C  dist (c a) (c b)" using assms by auto
    also have "...  lambda * dist a b + C"
      using quasi_isometry_onD[OF assms(1)] a < b by auto
    also have "... = lambda * (b-a) + C"
      using a < b dist_real_def by auto
    finally have *: "C  (b-a) * lambda" by (auto simp add: algebra_simps)
    define d where "d = (λx. geodesic_segment_param {(c a)--(c b)} (c a) ((dist (c a) (c b) /(b-a)) * (x-a)))"
    have dend: "d a = c a" "d b = c b" unfolding d_def using a < b by auto

    have Lip: "(2 * lambda)-lipschitz_on {a..b} d"
    proof -
      have "(1 * (((2 * lambda)) * (1+0)))-lipschitz_on {a..b} (λx. geodesic_segment_param {(c a)--(c b)} (c a) ((dist (c a) (c b) /(b-a)) * (x-a)))"
      proof (rule lipschitz_on_compose2[of _ _ "λx. ((dist (c a) (c b) /(b-a)) * (x-a))"], intro lipschitz_intros)
        have "(λx. dist (c a) (c b) / (b-a) * (x - a)) ` {a..b}  {0..dist (c a) (c b)}"
          apply auto using a < b by (auto simp add: algebra_simps divide_simps intro: mult_right_mono)
        moreover have "1-lipschitz_on {0..dist (c a) (c b)} (geodesic_segment_param {c a--c b} (c a))"
          by (rule isometry_on_lipschitz, simp)
        ultimately show "1-lipschitz_on ((λx. dist (c a) (c b) / (b-a) * (x - a)) ` {a..b}) (geodesic_segment_param {c a--c b} (c a))"
          using lipschitz_on_subset by auto

        have "dist (c a) (c b)  lambda * dist a b + C"
          apply (rule quasi_isometry_onD(1)[OF assms(1)])
          using a < b by auto
        also have "... = lambda * (b - a) + C"
          unfolding dist_real_def using a < b by auto
        also have "...  2 * lambda * (b-a)"
          using * by (auto simp add: algebra_simps)
        finally show "¦dist (c a) (c b) / (b - a)¦  2 * lambda"
          using a < b by (auto simp add: divide_simps)
      qed
      then show ?thesis unfolding d_def by auto
    qed
    have dist_c_d: "dist (c x) (d x)  4 * C" if H: "x  {a..b}" for x
    proof -
      have "(x-a) + (b - x)  2 * C/lambda"
        using that 3 by auto
      then consider "x-a  C/lambda" | "b - x  C/lambda" by linarith
      then have "v{a,b}. dist x v  C/lambda"
      proof (cases)
        case 1
        show ?thesis
          apply (rule bexI[of _ a]) using 1 H by (auto simp add: dist_real_def)
      next
        case 2
        show ?thesis
          apply (rule bexI[of _ b]) using 2 H by (auto simp add: dist_real_def)
      qed
      then obtain v where v: "v  {a,b}" "dist x v  C/lambda" by auto
      have "dist (c x) (d x)  dist (c x) (c v) + dist (c v) (d v) + dist (d v) (d x)"
        by (intro mono_intros)
      also have "...  (lambda * dist x v + C) + 0 + ((2 * lambda) * dist v x)"
        apply (intro mono_intros quasi_isometry_onD(1)[OF assms(1)] that lipschitz_onD[OF Lip])
        using v a < b dend by auto
      also have "...  (lambda * (C/lambda) + C) + 0 + ((2 * lambda) * (C/lambda))"
        apply (intro mono_intros) using C v by (auto simp add: metric_space_class.dist_commute)
      finally show ?thesis
        using C by (auto simp add: algebra_simps divide_simps)
    qed
    text ‹A similar argument shows that the Hausdorff distance between the images is bounded by $2C$.›
    have "hausdorff_distance (c`{a..b}) (d`{a..b})  2 * C"
    proof (rule hausdorff_distanceI2)
      show "0  2 * C" using C by auto
      fix z assume "z  c`{a..b}"
      then obtain x where x: "x  {a..b}" "z = c x" by auto
      have "(x-a) + (b - x)  2 * C/lambda"
        using x 3 by auto
      then consider "x-a  C/lambda" | "b - x  C/lambda" by linarith
      then have "v{a,b}. dist x v  C/lambda"
      proof (cases)
        case 1
        show ?thesis
          apply (rule bexI[of _ a]) using 1 x by (auto simp add: dist_real_def)
      next
        case 2
        show ?thesis
          apply (rule bexI[of _ b]) using 2 x by (auto simp add: dist_real_def)
      qed
      then obtain v where v: "v  {a,b}" "dist x v  C/lambda" by auto
      have "dist z (d v) = dist (c x) (c v)" unfolding x(2) using v dend by auto
      also have "...  lambda * dist x v + C"
        apply (rule quasi_isometry_onD(1)[OF assms(1)]) using v(1) x(1) by auto
      also have "...  lambda * (C/lambda) + C"
        apply (intro mono_intros) using C v(2) by auto
      also have "... = 2 * C"
        using C by (simp add: divide_simps)
      finally have *: "dist z (d v)  2 * C" by simp
      show "yd ` {a..b}. dist z y  2 * C"
        apply (rule bexI[of _ "d v"]) using * v(1) a < b by auto
    next
      fix z assume "z  d`{a..b}"
      then obtain x where x: "x  {a..b}" "z = d x" by auto
      have "(x-a) + (b - x)  2 * C/lambda"
        using x 3 by auto
      then consider "x-a  C/lambda" | "b - x  C/lambda" by linarith
      then have "v{a,b}. dist x v  C/lambda"
      proof (cases)
        case 1
        show ?thesis
          apply (rule bexI[of _ a]) using 1 x by (auto simp add: dist_real_def)
      next
        case 2
        show ?thesis
          apply (rule bexI[of _ b]) using 2 x by (auto simp add: dist_real_def)
      qed
      then obtain v where v: "v  {a,b}" "dist x v  C/lambda" by auto
      have "dist z (c v) = dist (d x) (d v)" unfolding x(2) using v dend by auto
      also have "...  2 * lambda * dist x v"
        apply (rule lipschitz_onD(1)[OF Lip]) using v(1) x(1) by auto
      also have "...  2 * lambda * (C/lambda)"
        apply (intro mono_intros) using C v(2) by auto
      also have "... = 2 * C"
        using C by (simp add: divide_simps)
      finally have *: "dist z (c v)  2 * C" by simp
      show "yc`{a..b}. dist z y  2 * C"
        apply (rule bexI[of _ "c v"]) using * v(1) a < b by auto
    qed
    have "lambda (4 * C)-quasi_isometry_on {a..b} d"
    proof
      show "1  lambda" using C by auto
      show "0  4 * C" using C by auto
      show "dist (d x) (d y)  lambda * dist x y + 4 * C" if "x  {a..b}" "y  {a..b}" for x y
      proof -
        have "dist (d x) (d y)  2 * lambda * dist x y"
          apply (rule lipschitz_onD[OF Lip]) using that by auto
        also have "... = lambda * dist x y + lambda * dist x y"
          by auto
        also have "...  lambda * dist x y + lambda * (2 * C/lambda)"
          apply (intro mono_intros) using 3 that C unfolding dist_real_def by auto
        also have "... = lambda * dist x y + 2 * C"
          using C by (simp add: algebra_simps divide_simps)
        finally show ?thesis using C by auto
      qed
      show "1 / lambda * dist x y - 4 * C  dist (d x) (d y)" if "x  {a..b}" "y  {a..b}" for x y
      proof -
        have "1/lambda * dist x y - 4 * C  lambda * dist x y - 2 * C"
          apply (intro mono_intros) using C by auto
        also have "...  lambda * (2 * C/lambda) - 2 * C"
          apply (intro mono_intros) using that 3 C unfolding dist_real_def by auto
        also have "... = 0"
          using C by (auto simp add: algebra_simps divide_simps)
        also have "...  dist (d x) (d y)" by auto
        finally show ?thesis by simp
      qed
    qed

    then have "continuous_on {a..b} d  d a = c a  d b = c b
           lambda (4 * C)-quasi_isometry_on {a..b} d
           (x{a..b}. dist (c x) (d x)  4 *C)
           (2*lambda)-lipschitz_on {a..b} d
           hausdorff_distance (c`{a..b}) (d`{a..b})  2 * C"
      using dist_c_d d a = c a d b = c b (2*lambda)-lipschitz_on {a..b} d
            ‹hausdorff_distance (c`{a..b}) (d`{a..b})  2 * C lipschitz_on_continuous_on by auto
    then show ?thesis by auto
  next
    text ‹Now, for the only nontrivial case, we use geodesic interpolation between the points
    $a$, $a + C/\lambda$, $\cdots$, $a+N\cdot C/\lambda$, $b'$, $b$ where $N$ is chosen so that
    the distance between $a+N C/\lambda$ and $b$ belongs to $[2C/\lambda, 3C/\lambda)$, and
    $b'$ is the middle of this interval. This gives a decomposition into intervals of length
    at most $3/2\cdot C/\lambda$.›
    case 4
    then have C: "C > 0" "lambda  1" using quasi_isometry_onD[OF assms(1)] by auto
    have "a < b" using 4 C by (smt divide_pos_pos)

    have [mono_intros]: "1/lambda  lambda" using C by (simp add: divide_simps mult_ge1_powers(1))
    define N where "N = floor((b-a)/(C/lambda)) - 2"
    have N: "N  (b-a)/(C/lambda)-2" "(b-a)/(C/lambda)  N + (3::real)"
      unfolding N_def by linarith+

    have "2 < (b-a)/(C/lambda)"
      using C 4 by (auto simp add: divide_simps algebra_simps)
    then have N0 : "0  N" unfolding N_def by auto
    define p where "p = (λt::int. a + (C/lambda) * t)"
    have pmono: "p i  p j" if "i  j" for i j
      unfolding p_def using that C by (auto simp add: algebra_simps divide_simps)
    have pmono': "p i < p j" if "i < j" for i j
      unfolding p_def using that C by (auto simp add: algebra_simps divide_simps)
    have "p (N+1)  b"
      unfolding p_def using C N by (auto simp add: algebra_simps divide_simps)
    then have pb: "p i  b" if "i  {0..N}" for i
      using that pmono by (meson atLeastAtMost_iff linear not_le order_trans zle_add1_eq_le)
    have bpN: "b - p N  {2 * C/lambda .. 3 * C/lambda}"
      unfolding p_def using C N apply (auto simp add: divide_simps)
      by (auto simp add: algebra_simps)
    have "p N < b" using pmono'[of N "N+1"] p (N+1)  b by auto
    define b' where "b' = (b + p N)/2"
    have b': "p N < b'" "b' < b" using p N < b unfolding b'_def by auto
    have pb': "p i  b'" if "i  {0..N}" for i
      using pmono[of i N] b' that by auto

    text ‹Introduce the set $A$ along which one will discretize.›
    define A where "A = p`{0..N}  {b', b}"
    have "finite A" unfolding A_def by auto
    have "b  A" unfolding A_def by auto
    have "p 0  A" unfolding A_def using 0  N by auto
    moreover have pa: "p 0 = a" unfolding p_def by auto
    ultimately have "a  A" by auto
    have "A  {a..b}"
      unfolding A_def using a < b b' pa pb pmono N0 by fastforce
    then have "b'  {a..<b}" unfolding A_def using b' < b by auto

    have A : "finite A" "A  {a..b}" "a  A" "b  A" "a < b" by fact+

    have nx: "next_in A x = x + C/lambda" if "x  A" "x  b" "x  b'" "x  p N" for x
    proof (rule next_inI[OF A])
      show "x  {a..<b}" using x  A A  {a..b} x  b by auto
      obtain i where i: "x = p i" "i  {0..N}"
        using x  A x  b x  b' unfolding A_def by auto
      have *: "p (i+1) = x + C/lambda" unfolding i(1) p_def by (auto simp add: algebra_simps)
      have "i  N" using that i by auto
      then have "i + 1  {0..N}" using i  {0..N} by auto
      then have "p (i+1)  A" unfolding A_def by fastforce
      then show "x + C/lambda  A" unfolding * by auto
      show "x < x + C / lambda" using C by auto
      show "{x<..<x + C / lambda}  A = {}"
      proof (auto)
        fix y assume y: "y  A" "x < y" "y < x + C/lambda"
        consider "y = b" | "y = b'" | "ji. y = p j" | "j>i. y = p j"
          using y  A not_less unfolding A_def by auto
        then show False
        proof (cases)
          case 1
          have "x + C/lambda  b" unfolding *[symmetric] using i + 1  {0..N} pb by auto
          then show False using y(3) unfolding 1 i(1) by auto
        next
          case 2
          have "x + C/lambda  b'" unfolding *[symmetric] using i + 1  {0..N} pb' by auto
          then show False using y(3) unfolding 2 i(1) by auto
        next
          case 3
          then obtain j where j: "j  i" "y = p j" by auto
          have "y  x" unfolding j(2) i(1) using pmono[OF j  i] by simp
          then show False using x < y by auto
        next
          case 4
          then obtain j where j: "j > i" "y = p j" by auto
          then have "i+1  j" by auto
          have "x + C/lambda  y" unfolding j(2) *[symmetric] using pmono[OF i+1  j] by auto
          then show False using y < x + C/lambda by auto
        qed
      qed
    qed
    have npN: "next_in A (p N) = b'"
    proof (rule next_inI[OF A])
      show "p N  {a..<b}" using pa pmono 0  N p N < b by auto
      show "p N < b'" by fact
      show "b'  A" unfolding A_def by auto
      show "{p N<..<b'}  A = {}"
        unfolding A_def using pmono b' by force
    qed
    have nb': "next_in A (b') = b"
    proof (rule next_inI[OF A])
      show "b'  {a..<b}" using A_def A b' < b by auto
      show "b' < b" by fact
      show "b  A" by fact
      show "{b'<..<b}  A = {}"
        unfolding A_def using pmono b' by force
    qed
    have gap: "next_in A x - x  {C/lambda.. 3/2 * C/lambda}" if "x  A - {b}" for x
    proof (cases "x = p N  x = b'")
      case True
      then show ?thesis using npN nb' bpN b'_def by force
    next
      case False
      have *: "next_in A x = x + C/lambda"
        apply (rule nx) using that False by auto
      show ?thesis unfolding * using C by (auto simp add: algebra_simps divide_simps)
    qed

    text ‹We can now define the function $d$, by geodesic interpolation between points in $A$.›
    define d where "d x = (if x  A then c x
        else geodesic_segment_param {c (prev_in A x) -- c (next_in A x)} (c (prev_in A x))
            ((x - prev_in A x)/(next_in A x - prev_in A x) * dist (c(prev_in A x)) (c(next_in A x))))" for x
    have "d a = c a" "d b = c b" unfolding d_def using a  A b  A by auto

    text ‹To prove the Lipschitz continuity, we argue that $d$ is Lipschitz on finitely many intervals,
    that cover the interval $[a,b]$, the intervals between points in $A$.
    There is a formula for $d$ on them (the nontrivial point is that the above formulas for $d$
    match at the boundaries).›

    have *: "d x = geodesic_segment_param {(c u)--(c v)} (c u) ((dist (c u) (c v) /(v-u)) * (x-u))"
      if "u  A - {b}" "v = next_in A u" "x  {u..v}" for x u v
    proof -
      have "u  {a..<b}" using that A  {a..b} by fastforce
      have H: "u  A" "v  A" "u < v" "A  {u<..<v} = {}" using that next_in_basics[OF A u  {a..<b}] by auto
      consider "x = u" | "x = v" | "x  {u<..<v}" using x  {u..v} by fastforce
      then show ?thesis
      proof (cases)
        case 1
        then have "d x = c u" unfolding d_def using u  A- {b} A  {a..b} by auto
        then show ?thesis unfolding 1 by auto
      next
        case 2
        then have "d x = c v" unfolding d_def using v  A A  {a..b} by auto
        then show ?thesis unfolding 2 using u < v by auto
      next
        case 3
        have *: "prev_in A x = u"
          apply (rule prev_inI[OF A]) using 3 H A  {a..b} by auto
        have **: "next_in A x = v"
          apply (rule next_inI[OF A]) using 3 H A  {a..b} by auto
        show ?thesis unfolding d_def * ** using 3 H A  {u<..<v} = {} A  {a..b}
          by (auto simp add: algebra_simps)
      qed
    qed

    text ‹From the above formula, we deduce that $d$ is Lipschitz on those intervals.›
    have lip0: "(lambda + C / (next_in A u - u))-lipschitz_on {u..next_in A u} d" if "u  A - {b}" for u
    proof -
      define v where "v = next_in A u"
      have "u  {a..<b}" using that A  {a..b} by fastforce
      have "u  A" "v  A" "u < v" "A  {u<..<v} = {}"
        unfolding v_def using that next_in_basics[OF A u  {a..<b}] by auto

      have "(1 * (((lambda + C / (next_in A u - u))) * (1+0)))-lipschitz_on {u..v} (λx. geodesic_segment_param {(c u)--(c v)} (c u) ((dist (c u) (c v) /(v-u)) * (x-u)))"
      proof (rule lipschitz_on_compose2[of _ _ "λx. ((dist (c u) (c v) /(v-u)) * (x-u))"], intro lipschitz_intros)
        have "(λx. dist (c u) (c v) / (v - u) * (x - u)) ` {u..v}  {0..dist (c u) (c v)}"
          apply auto using u < v by (auto simp add: algebra_simps divide_simps intro: mult_right_mono)
        moreover have "1-lipschitz_on {0..dist (c u) (c v)} (geodesic_segment_param {c u--c v} (c u))"
          by (rule isometry_on_lipschitz, simp)
        ultimately show "1-lipschitz_on ((λx. dist (c u) (c v) / (v - u) * (x - u)) ` {u..v}) (geodesic_segment_param {c u--c v} (c u))"
          using lipschitz_on_subset by auto

        have "dist (c u) (c v)  lambda * dist u v + C"
          apply (rule quasi_isometry_onD(1)[OF assms(1)])
          using u  A v  A A  {a..b} by auto
        also have "... = lambda * (v - u) + C"
          unfolding dist_real_def using u < v by auto
        finally show "¦dist (c u) (c v) / (v - u)¦  lambda + C / (next_in A u - u)"
          using u < v unfolding v_def by (auto simp add: divide_simps)
      qed
      then show ?thesis
        using *[OF u  A -{b} v = next_in A u] unfolding v_def
        by (auto intro: lipschitz_on_transform)
    qed
    have lip: "(2 * lambda)-lipschitz_on {u..next_in A u} d" if "u  A - {b}" for u
    proof (rule lipschitz_on_mono[OF lip0[OF that]], auto)
      define v where "v = next_in A u"
      have "u  {a..<b}" using that A  {a..b} by fastforce
      have "u  A" "v  A" "u < v" "A  {u<..<v} = {}"
        unfolding v_def using that next_in_basics[OF A u  {a..<b}] by auto
      have Duv: "v - u  {C/lambda .. 2 * C/lambda}"
        unfolding v_def using gap[OF u  A - {b}] by simp
      then show " C / (next_in A u - u)  lambda"
        using u < v C unfolding v_def by (auto simp add: algebra_simps divide_simps)
    qed

    text ‹The Lipschitz continuity of $d$ now follows from its Lipschitz continuity on each
    subinterval in $I$.›
    have Lip: "(2 * lambda)-lipschitz_on {a..b} d"
      apply (rule lipschitz_on_closed_Union[of "{{u..next_in A u} |u. u  A - {b}}" _ "λx. x"])
      using lip ‹finite A C intervals_decomposition[OF A] using assms by auto
    then have "continuous_on {a..b} d"
      using lipschitz_on_continuous_on by auto

    text ‹$d$ has good upper controls on each basic interval.›
    have QI0: "dist (d x) (d y)  lambda * dist x y + C"
      if H: "u  A - {b}" "x  {u..next_in A u}" "y  {u..next_in A u}" for u x y
    proof -
      have "u < next_in A u" using H(1) A next_in_basics(2)[OF A] by auto
      moreover have "dist x y  next_in A u - u" unfolding dist_real_def using H by auto
      ultimately have *: "dist x y / (next_in A u - u)  1" by (simp add: divide_simps)
      have "dist (d x) (d y)  (lambda + C / (next_in A u - u)) * dist x y"
        by (rule lipschitz_onD[OF lip0[OF H(1)] H(2) H(3)])
      also have "... = lambda * dist x y + C * (dist x y / (next_in A u - u))"
        by (simp add: algebra_simps)
      also have "...  lambda * dist x y + C * 1"
        apply (intro mono_intros) using C * by auto
      finally show ?thesis by simp
    qed

    text ‹We can now show that $c$ and $d$ are pointwise close. This follows from the fact that they
    coincide on $A$ and are well controlled in between (for $c$, this is a consequence of the choice
    of $A$. For $d$, it follows from the fact that it is geodesic in the intervals).›

    have dist_c_d: "dist (c x) (d x)  4 * C" if "x  {a..b}" for x
    proof -
      obtain u where u: "u  A - {b}" "x  {u..next_in A u}"
        using x  {a..b} intervals_decomposition[OF A] by blast
      have "(x-u) + (next_in A u - x)  2 * C/lambda"
        using gap[OF u(1)] by auto
      then consider "x-u  C/lambda" | "next_in A u - x  C/lambda" by linarith
      then have "vA. dist x v  C/lambda"
      proof (cases)
        case 1
        show ?thesis
          apply (rule bexI[of _ u]) using 1 u by (auto simp add: dist_real_def)
      next
        case 2
        show ?thesis
          apply (rule bexI[of _ "next_in A u"]) using 2 u A(2)
          by (auto simp add: dist_real_def intro!:next_in_basics[OF A])
      qed
      then obtain v where v: "v  A" "dist x v  C/lambda" by auto
      have "dist (c x) (d x)  dist (c x) (c v) + dist (c v) (d v) + dist (d v) (d x)"
        by (intro mono_intros)
      also have "...  (lambda * dist x v + C) + 0 + ((2 * lambda) * dist v x)"
        apply (intro mono_intros quasi_isometry_onD(1)[OF assms(1)] that lipschitz_onD[OF Lip])
        using A(2) v  A apply blast
        using v  A d_def apply auto[1]
        using A(2) v  A by blast
      also have "...  (lambda * (C/lambda) + C) + 0 + ((2 * lambda) * (C/lambda))"
        apply (intro mono_intros) using v(2) C by (auto simp add: metric_space_class.dist_commute)
      finally show ?thesis
        using C by (auto simp add: algebra_simps divide_simps)
    qed
    text ‹A similar argument shows that the Hausdorff distance between the images is bounded by $2C$.›
    have "hausdorff_distance (c`{a..b}) (d`{a..b})  2 * C"
    proof (rule hausdorff_distanceI2)
      show "0  2 * C" using C by auto
      fix z assume "z  c`{a..b}"
      then obtain x where x: "x  {a..b}" "z = c x" by auto
      then obtain u where u: "u  A - {b}" "x  {u..next_in A u}"
        using intervals_decomposition[OF A] by blast
      have "(x-u) + (next_in A u - x)  2 * C/lambda"
        using gap[OF u(1)] by auto
      then consider "x-u  C/lambda" | "next_in A u - x  C/lambda" by linarith
      then have "vA. dist x v  C/lambda"
      proof (cases)
        case 1
        show ?thesis
          apply (rule bexI[of _ u]) using 1 u by (auto simp add: dist_real_def)
      next
        case 2
        show ?thesis
          apply (rule bexI[of _ "next_in A u"]) using 2 u A(2)
          by (auto simp add: dist_real_def intro!:next_in_basics[OF A])
      qed
      then obtain v where v: "v  A" "dist x v  C/lambda" by auto
      have "dist z (d v) = dist (c x) (c v)" unfolding x(2) d_def using v  A by auto
      also have "...  lambda * dist x v + C"
        apply (rule quasi_isometry_onD(1)[OF assms(1)]) using v(1) A(2) x(1) by auto
      also have "...  lambda * (C/lambda) + C"
        apply (intro mono_intros) using C v(2) by auto
      also have "... = 2 * C"
        using C by (simp add: divide_simps)
      finally have *: "dist z (d v)  2 * C" by simp
      show "yd ` {a..b}. dist z y  2 * C"
        apply (rule bexI[of _ "d v"]) using * v(1) A(2) by auto
    next
      fix z assume "z  d`{a..b}"
      then obtain x where x: "x  {a..b}" "z = d x" by auto
      then obtain u where u: "u  A - {b}" "x  {u..next_in A u}"
        using intervals_decomposition[OF A] by blast
      have "(x-u) + (next_in A u - x)  2 * C/lambda"
        using gap[OF u(1)] by auto
      then consider "x-u  C/lambda" | "next_in A u - x  C/lambda" by linarith
      then have "vA. dist x v  C/lambda"
      proof (cases)
        case 1
        show ?thesis
          apply (rule bexI[of _ u]) using 1 u by (auto simp add: dist_real_def)
      next
        case 2
        show ?thesis
          apply (rule bexI[of _ "next_in A u"]) using 2 u A(2)
          by (auto simp add: dist_real_def intro!:next_in_basics[OF A])
      qed
      then obtain v where v: "v  A" "dist x v  C/lambda" by auto
      have "dist z (c v) = dist (d x) (d v)" unfolding x(2) d_def using v  A by auto
      also have "...  2 * lambda * dist x v"
        apply (rule lipschitz_onD(1)[OF Lip]) using v(1) A(2) x(1) by auto
      also have "...  2 * lambda * (C/lambda)"
        apply (intro mono_intros) using C v(2) by auto
      also have "... = 2 * C"
        using C by (simp add: divide_simps)
      finally have *: "dist z (c v)  2 * C" by simp
      show "yc`{a..b}. dist z y  2 * C"
        apply (rule bexI[of _ "c v"]) using * v(1) A(2) by auto
    qed

    text ‹From the above controls, we check that $d$ is a quasi-isometry, with explicit constants.›
    have "lambda (4 * C)-quasi_isometry_on {a..b} d"
    proof
      show "1  lambda" using C by auto
      show "0  4 * C" using C by auto
      have I : "dist (d x) (d y)  lambda * dist x y + 4 * C" if H: "x  {a..b}" "y  {a..b}" "x < y" for x y
      proof -
        obtain u where u: "u  A - {b}" "x  {u..next_in A u}"
          using intervals_decomposition[OF A] H(1) by force
        have "u  {a..<b}" using u(1) A by auto
        have "next_in A u  A" using next_in_basics(1)[OF A u  {a..<b}] by auto
        obtain v where v: "v  A - {b}" "y  {v..next_in A v}"
          using intervals_decomposition[OF A] H(2) by force
        have "v  {a..<b}" using v(1) A by auto
        have "u < next_in A v" using H(3) u(2) v(2) by auto
        then have "u  v"
          using u(1) next_in_basics(3)[OF A, OF v  {a..<b}] by auto
        show ?thesis
        proof (cases "u = v")
          case True
          have "dist (d x) (d y)  lambda * dist x y + C"
            apply (rule QI0[OF u]) using v(2) True by auto
          also have "...  lambda * dist x y + 4 * C"
            using C by auto
          finally show ?thesis by simp
        next
          case False
          then have "u < v" using u  v by auto
          then have "next_in A u  v" using v(1) next_in_basics(3)[OF A, OF u  {a..<b}] by auto
          have d1: "d (next_in A u) = c (next_in A u)"
            using ‹next_in A u  A unfolding d_def by auto
          have d2: "d v = c v"
            using v(1) unfolding d_def by auto
          have "dist (d x) (d y)  dist (d x) (d (next_in A u)) + dist (d (next_in A u)) (d v) + dist (d v) (d y)"
            by (intro mono_intros)
          also have "...  (lambda * dist x (next_in A u) + C) + (lambda * dist (next_in A u) v + C)
                            + (lambda * dist v y + C)"
            apply (intro mono_intros)
              apply (rule QI0[OF u]) using u(2) apply simp
             apply (simp add: d1 d2) apply (rule quasi_isometry_onD(1)[OF assms(1)])
            using ‹next_in A u  A A  {a..b} apply auto[1]
            using v  A - {b} A  {a..b} apply auto[1]
            apply (rule QI0[OF v(1)]) using v(2) by auto
          also have "... = lambda * dist x y + 3 * C"
            unfolding dist_real_def
            using x  {u..next_in A u} y  {v..next_in A v} x < y ‹next_in A u  v
            by (auto simp add: algebra_simps)
          finally show ?thesis using C by simp
        qed
      qed
      show "dist (d x) (d y)  lambda * dist x y + 4 * C" if H: "x  {a..b}" "y  {a..b}" for x y
      proof -
        consider "x < y" | "x = y" | "x > y" by linarith
        then show ?thesis
        proof (cases)
          case 1
          then show ?thesis using I[OF H(1) H(2) 1] by simp
        next
          case 2
          show ?thesis unfolding 2 using C by auto
        next
          case 3
          show ?thesis using I [OF H(2) H(1) 3] by (simp add: metric_space_class.dist_commute)
        qed
      qed
      text ‹The lower bound is more tricky. We separate the case where $x$ and $y$ are in the same
      interval, when they are in different nearby intervals, and when they are in different
      separated intervals. The latter case is more difficult. In this case, one of the intervals
      has length $C/\lambda$ and the other one has length at most $3/2\cdot C/\lambda$. There,
      we approximate $dist (d x) (d y)$ by $dist (d u') (d v')$ where $u'$ and $v'$ are suitable
      endpoints of the intervals containing respectively $x$ and $y$. We use the inner endpoint
      (between $x$ and $y$) if the distance between $x$ or $y$ and this point is less than $2/5$
      of the length of the interval, and the outer endpoint otherwise. The reason is that, with
      the outer endpoints, we get right away an upper bound for the distance between $x$ and $y$,
      while this is not the case with the inner endpoints where there is an additional error.
      The equilibrium is reached at proportion $2/5$. ›
      have J : "dist (d x) (d y)  (1/lambda) * dist x y - 4 * C" if H: "x  {a..b}" "y  {a..b}" "x < y" for x y
      proof -
        obtain u where u: "u  A - {b}" "x  {u..next_in A u}"
          using intervals_decomposition[OF A] H(1) by force
        have "u  {a..<b}" using u(1) A by auto
        have "next_in A u  A" using next_in_basics(1)[OF A u  {a..<b}] by auto
        obtain v where v: "v  A - {b}" "y  {v..next_in A v}"
          using intervals_decomposition[OF A] H(2) by force
        have "v  {a..<b}" using v(1) A by auto
        have "next_in A v  A" using next_in_basics(1)[OF A v  {a..<b}] by auto
        have "u < next_in A v" using H(3) u(2) v(2) by auto
        then have "u  v"
          using u(1) next_in_basics(3)[OF A, OF v  {a..<b}] by auto
        consider "v = u" | "v = next_in A u" | "v  u  v  next_in A u" by auto
        then show ?thesis
        proof (cases)
          case 1
          have "(1/lambda) * dist x y - 4 * C  lambda * dist x y - 4 * C"
            apply (intro mono_intros) by auto
          also have "...  lambda * (3/2 * C/lambda) - 3/2 * C"
            apply (intro mono_intros)
            using u(2) v(2) unfolding 1 using C gap[OF u(1)] dist_real_def x < y by auto
          also have "... = 0"
            using C by auto
          also have "...  dist (d x) (d y)"
            by auto
          finally show ?thesis by simp
        next
          case 2
          have "dist x y  dist x (next_in A u) + dist v y"
            unfolding 2 by (intro mono_intros)
          also have "...  3/2 * C/lambda + 3/2 * C/lambda"
            apply (intro mono_intros)
            unfolding dist_real_def using u(2) v(2) gap[OF u(1)] gap[OF v(1)] by auto
          finally have *: "dist x y  3 * C/lambda" by auto
          have "(1/lambda) * dist x y - 4 * C  lambda * dist x y - 4 * C"
            apply (intro mono_intros) by auto
          also have "...  lambda * (3 * C/lambda) - 3 * C"
            apply (intro mono_intros)
            using * C by auto
          also have "... = 0"
            using C by auto
          also have "...  dist (d x) (d y)"
            by auto
          finally show ?thesis by simp
        next
          case 3
          then have "u < v" using u  v by auto
          then have *: "next_in A u < v" using v(1) next_in_basics(3)[OF A u  {a..<b}] 3 by auto
          have nu: "next_in A u = u + C/lambda"
          proof (rule nx)
            show "u  A" using u(1) by auto
            show "u  b" using u(1) by auto
            show "u  b'"
            proof
              assume H: "u = b'"
              have "b < v" using * unfolding H nb' by simp
              then show False using v  {a..<b} by auto
            qed
            show "u  p N"
            proof
              assume H: "u = p N"
              have "b' < v" using * unfolding H npN by simp
              then have "next_in A b'  v" using next_in_basics(3)[OF A b'  {a..<b}] v by force
              then show False unfolding nb' using v  {a..<b} by auto
            qed
          qed
          have nv: "next_in A v  v + 3/2 * C/lambda" using gap[OF v(1)] by auto

          have d: "d u = c u" "d (next_in A u) = c (next_in A u)" "d v = c v" "d (next_in A v) = c (next_in A v)"
            using u  A - {b} ‹next_in A u  A v  A - {b} ‹next_in A v  A unfolding d_def by auto

          text ‹The interval containing $x$ has length $C/\lambda$, while the interval containing
          $y$ has length at most $\leq 3/2 C/\lambda$. Therefore, $x$ is at proportion $2/5$ of the inner point
          if $x > u + (3/5) C/\lambda$, and $y$ is at proportion $2/5$ of the inner point if
          $y < v + (2/5) \cdot 3/2 \cdot C/\lambda = v + (3/5)C/\lambda$.›
          consider "x  u + (3/5) * C/lambda  y  v + (3/5) * C/lambda"
                 | "x  u + (3/5) * C/lambda  y  v + (3/5) * C/lambda"
                 | "x  u + (3/5) * C/lambda  y  v + (3/5) * C/lambda"
                 | "x  u + (3/5) * C/lambda  y  v + (3/5) * C/lambda"
            by linarith
          then show ?thesis
          proof (cases)
            case 1
            have "(1/lambda) * dist u v - C  dist (c u) (c v)"
              apply (rule quasi_isometry_onD(2)[OF assms(1)])
              using u  A - {b} v  A - {b} A  {a..b} by auto
            also have "... = dist (d u) (d v)"
              using d by auto
            also have "...  dist (d u) (d x) + dist (d x) (d y) + dist (d y) (d v)"
              by (intro mono_intros)
            also have "...  (2 * lambda * dist u x) + dist (d x) (d y) + (2 * lambda * dist y v)"
              apply (intro mono_intros)
              apply (rule lipschitz_onD[OF lip[OF u(1)]]) using u(2) apply auto[1] using u(2) apply auto[1]
              apply (rule lipschitz_onD[OF lip[OF v(1)]]) using v(2) by auto
            also have "...  (2 * lambda * (3/5 * C/lambda)) + dist (d x) (d y) + (2 * lambda * (3/5 * C/lambda))"
              apply (intro mono_intros)
              unfolding dist_real_def using 1 u v C by auto
            also have "... = 12/5 * C + dist (d x) (d y)"
              using C by (auto simp add: algebra_simps divide_simps)
            finally have *: "(1/lambda) * dist u v  dist (d x) (d y) + 17/5 * C" by auto

            have "(1/lambda) * dist x y  (1/lambda) * (dist u v + dist v y)"
              apply (intro mono_intros)
              unfolding dist_real_def using C u(2) v(2) x < y by auto
            also have "...  (1/lambda) * (dist u v + 3/5 * C/lambda)"
              apply (intro mono_intros)
              unfolding dist_real_def using 1 v(2) C by auto
            also have "... = (1/lambda) * dist u v + 3/5 * C * (1/(lambda * lambda))"
              using C by (auto simp add: algebra_simps divide_simps)
            also have "...  (1/lambda) * dist u v + 3/5 * C * 1"
              apply (intro mono_intros)
              using C by (auto simp add: divide_simps algebra_simps mult_ge1_powers(1))
            also have "...  (dist (d x) (d y) + 17/5 * C) + 3/5 * C * 1"
              using * by auto
            finally show ?thesis by auto
          next
            case 2
            have "(1/lambda) * dist (next_in A u) v - C  dist (c (next_in A u)) (c v)"
              apply (rule quasi_isometry_onD(2)[OF assms(1)])
              using ‹next_in A u  A v  A - {b} A  {a..b} by auto
            also have "... = dist (d (next_in A u)) (d v)"
              using d by auto
            also have "...  dist (d (next_in A u)) (d x) + dist (d x) (d y) + dist (d y) (d v)"
              by (intro mono_intros)
            also have "...  (2 * lambda * dist (next_in A u) x) + dist (d x) (d y) + (2 * lambda * dist y v)"
              apply (intro mono_intros)
              apply (rule lipschitz_onD[OF lip[OF u(1)]]) using u(2) apply auto[1] using u(2) apply auto[1]
              apply (rule lipschitz_onD[OF lip[OF v(1)]]) using v(2) by auto
            also have "...  (2 * lambda * (2/5 * C/lambda)) + dist (d x) (d y) + (2 * lambda * (3/5 * C/lambda))"
              apply (intro mono_intros)
              unfolding dist_real_def using 2 u v C nu by auto
            also have "... = 2 * C + dist (d x) (d y)"
              using C by (auto simp add: algebra_simps divide_simps)
            finally have *: "(1/lambda) * dist (next_in A u) v  dist (d x) (d y) + 3 * C" by auto

            have "(1/lambda) * dist x y  (1/lambda) * (dist x (next_in A u) + dist (next_in A u) v + dist v y)"
              apply (intro mono_intros)
              unfolding dist_real_def using C u(2) v(2) x < y by auto
            also have "...  (1/lambda) * ((2/5 * C/lambda) + dist (next_in A u) v  + (3/5 * C/lambda))"
              apply (intro mono_intros)
              unfolding dist_real_def using 2 u(2) v(2) C nu by auto
            also have "... = (1/lambda) * dist (next_in A u) v + C * (1/(lambda * lambda))"
              using C by (auto simp add: algebra_simps divide_simps)
            also have "...  (1/lambda) * dist (next_in A u) v + C * 1"
              apply (intro mono_intros)
              using C by (auto simp add: divide_simps algebra_simps mult_ge1_powers(1))
            also have "...  (dist (d x) (d y) + 3 * C) + C * 1"
              using * by auto
            finally show ?thesis by auto
          next
            case 3
            have "(1/lambda) * dist u (next_in A v) - C  dist (c u) (c (next_in A v))"
              apply (rule quasi_isometry_onD(2)[OF assms(1)])
              using u  A - {b} ‹next_in A v  A A  {a..b} by auto
            also have "... = dist (d u) (d (next_in A v))"
              using d by auto
            also have "...  dist (d u) (d x) + dist (d x) (d y) + dist (d y) (d (next_in A v))"
              by (intro mono_intros)
            also have "...  (2 * lambda * dist u x) + dist (d x) (d y) + (2 * lambda * dist y (next_in A v))"
              apply (intro mono_intros)
              apply (rule lipschitz_onD[OF lip[OF u(1)]]) using u(2) apply auto[1] using u(2) apply auto[1]
              apply (rule lipschitz_onD[OF lip[OF v(1)]]) using v(2) by auto
            also have "...  (2 * lambda * (3/5 * C/lambda)) + dist (d x) (d y) + (2 * lambda * (9/10 * C/lambda))"
              apply (intro mono_intros)
              unfolding dist_real_def using 3 u v C nv by auto
            also have "... = 3 * C + dist (d x) (d y)"
              using C by (auto simp add: algebra_simps divide_simps)
            finally have *: "(1/lambda) * dist u (next_in A v)  dist (d x) (d y) + 4 * C" by auto

            have "(1/lambda) * dist x y  (1/lambda) * dist u (next_in A v)"
              apply (intro mono_intros)
              unfolding dist_real_def using C u(2) v(2) x < y by auto
            also have "...  dist (d x) (d y) + 4 * C"
              using * by auto
            finally show ?thesis by auto
          next
            case 4
            have "(1/lambda) * dist (next_in A u) (next_in A v) - C  dist (c (next_in A u)) (c (next_in A v))"
              apply (rule quasi_isometry_onD(2)[OF assms(1)])
              using ‹next_in A u  A ‹next_in A v  A A  {a..b} by auto
            also have "... = dist (d (next_in A u)) (d (next_in A v))"
              using d by auto
            also have "...  dist (d (next_in A u)) (d x) + dist (d x) (d y) + dist (d y) (d (next_in A v))"
              by (intro mono_intros)
            also have "...  (2 * lambda * dist (next_in A u) x) + dist (d x) (d y) + (2 * lambda * dist y (next_in A v))"
              apply (intro mono_intros)
              apply (rule lipschitz_onD[OF lip[OF u(1)]]) using u(2) apply auto[1] using u(2) apply auto[1]
              apply (rule lipschitz_onD[OF lip[OF v(1)]]) using v(2) by auto
            also have "...  (2 * lambda * (2/5 * C/lambda)) + dist (d x) (d y) + (2 * lambda * (9/10 * C/lambda))"
              apply (intro mono_intros)
              unfolding dist_real_def using 4 u v C nu nv by auto
            also have "... = 13/5 * C + dist (d x) (d y)"
              using C by (auto simp add: algebra_simps divide_simps)
            finally have *: "(1/lambda) * dist (next_in A u) (next_in A v)  dist (d x) (d y) + 18/5 * C" by auto

            have "(1/lambda) * dist x y  (1/lambda) * (dist x (next_in A u) + dist (next_in A u) (next_in A v))"
              apply (intro mono_intros)
              unfolding dist_real_def using C u(2) v(2) x < y by auto
            also have "...  (1/lambda) * ((2/5 *C/lambda) + dist (next_in A u) (next_in A v))"
              apply (intro mono_intros)
              unfolding dist_real_def using 4 u(2) v(2) C nu by auto
            also have "... = (1/lambda) * dist (next_in A u) (next_in A v) + 2/5 * C * (1/(lambda * lambda))"
              using C by (auto simp add: algebra_simps divide_simps)
            also have "...  (1/lambda) * dist (next_in A u) (next_in A v) + 2/5 * C * 1"
              apply (intro mono_intros)
              using C by (auto simp add: divide_simps algebra_simps mult_ge1_powers(1))
            also have "...  (dist (d x) (d y) + 18/5 * C) + 2/5 * C * 1"
              using * by auto
            finally show ?thesis by auto
          qed
        qed
      qed
      show "dist (d x) (d y)  (1/lambda) * dist x y - 4 * C" if H: "x  {a..b}" "y  {a..b}" for x y
      proof -
        consider "x < y" | "x = y" | "x > y" by linarith
        then show ?thesis
        proof (cases)
          case 1
          then show ?thesis using J[OF H(1) H(2) 1] by simp
        next
          case 2
          show ?thesis unfolding 2 using C by auto
        next
          case 3
          show ?thesis using J[OF H(2) H(1) 3] by (simp add: metric_space_class.dist_commute)
        qed
      qed
    qed

    text ‹We have proved that $d$ has all the properties we wanted.›
    then have "continuous_on {a..b} d  d a = c a  d b = c b
           lambda (4 * C)-quasi_isometry_on {a..b} d
           (x{a..b}. dist (c x) (d x)  4 *C)
           (2*lambda)-lipschitz_on {a..b} d
           hausdorff_distance (c`{a..b}) (d`{a..b})  2 * C"
      using dist_c_d ‹continuous_on {a..b} d d a = c a d b = c b (2*lambda)-lipschitz_on {a..b} d
            ‹hausdorff_distance (c`{a..b}) (d`{a..b})  2 * C by auto
    then show ?thesis by auto
  qed
qed

end (*of theory Isometries*)

Theory Metric_Completion

(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
    License: BSD
*)

section ‹The metric completion of a metric space›

theory Metric_Completion
  imports Isometries
begin

text ‹Any metric space can be completed, by adding the missing limits of Cauchy sequences.
Formally, there exists an isometric embedding of the space in a complete space, with dense image.
In this paragraph, we construct this metric completion. This is exactly the same construction
as the way in which real numbers are constructed from rational numbers.›

subsection ‹Definition of the metric completion›

quotient_type (overloaded) 'a metric_completion =
  "nat  ('a::metric_space)" / partial: "λu v. (Cauchy u)  (Cauchy v)  (λn. dist (u n) (v n))  0"
unfolding part_equivp_def proof(auto intro!: ext)
  show "x. Cauchy x"
    by (rule exI[of _ "λ_. undefined"]) (simp add: convergent_Cauchy convergent_const)
  fix x y z::"nat  'a" assume H: "(λn. dist (x n) (y n))  0"
                                   "(λn. dist (x n) (z n))  0"
  have *: "(λn. dist (x n) (y n) + dist (x n) (z n))  0 + 0"
    by (rule tendsto_add) (auto simp add: H)
  show "(λn. dist (y n) (z n))  0"
    apply (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. dist (x n) (y n) + dist (x n) (z n)"])
    using * by (auto simp add: dist_triangle3)
next
  fix x y z::"nat  'a" assume H: "(λn. dist (x n) (y n))  0"
                                   "(λn. dist (y n) (z n))  0"
  have *: "(λn. dist (x n) (y n) + dist (y n) (z n))  0 + 0"
    by (rule tendsto_add) (auto simp add: H)
  show "(λn. dist (x n) (z n))  0"
    apply (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. dist (x n) (y n) + dist (y n) (z n)"])
    using * by (auto simp add: dist_triangle)
next
  fix x y::"nat  'a" assume H: "Cauchy x"
    "(λv. Cauchy v  (λn. dist (x n) (v n))  0) = (λv. Cauchy v  (λn. dist (y n) (v n))  0)"
  have "Cauchy x  (λn. dist (x n) (x n))  0" using H by auto
  then have "(λn. dist (y n) (x n)) 0" using H by meson
  moreover have "dist (x n) (y n) = dist (y n) (x n)" for n using dist_commute by auto
  ultimately show "(λn. dist (x n) (y n))  0" by auto
qed

text ‹We have to show that the metric completion is indeed a metric space, that
the original space embeds isometrically into it, and that it is complete. Before we prove these
statements, we start with two simple lemmas that will be needed later on.›

lemma convergent_Cauchy_dist:
  fixes u v::"nat  ('a::metric_space)"
  assumes "Cauchy u" "Cauchy v"
  shows "convergent (λn. dist (u n) (v n))"
proof (rule real_Cauchy_convergent, intro CauchyI)
  fix e::real assume "e > 0"
  obtain Nu where Nu: "n  Nu. m  Nu. dist (u n) (u m) < e/2" using assms(1)
    by (metis 0 < e less_divide_eq_numeral1(1) metric_CauchyD mult_zero_left)
  obtain Nv where Nv: "n  Nv. m  Nv. dist (v n) (v m) < e/2" using assms(2)
    by (metis 0 < e less_divide_eq_numeral1(1) metric_CauchyD mult_zero_left)
  define M where "M = max Nu Nv"
  {
    fix n m assume H: "n  M" "m  M"
    have *: "dist (u n) (u m) < e/2" "dist (v n) (v m) < e/2"
      using Nu Nv H unfolding M_def by auto
    have "dist (u m) (v m) - dist (u n) (v n)  dist (u m) (u n) + dist (v n) (v m)"
      by (simp add: algebra_simps) (metis add_le_cancel_left dist_commute dist_triangle2 dist_triangle_le)
    also have "... < e/2 + e/2"
      using * by (simp add: dist_commute)
    finally have A: "dist (u m) (v m) - dist (u n) (v n) < e" by simp

    have "dist (u n) (v n) - dist (u m) (v m)  dist (u m) (u n) + dist (v n) (v m)"
      by (simp add: algebra_simps) (metis add_le_cancel_left dist_commute dist_triangle2 dist_triangle_le)
    also have "... < e/2 + e/2"
      using * by (simp add: dist_commute)
    finally have "dist (u n) (v n) - dist (u m) (v m) < e" by simp
    then have "norm(dist (u m) (v m) - dist (u n) (v n)) < e" using A by auto
  }
  then show "M. m  M. n  M. norm (dist (u m) (v m) - dist (u n) (v n)) < e"
    by auto
qed

lemma convergent_add_null:
  fixes u v::"nat  ('a::real_normed_vector)"
  assumes "convergent u"
          "(λn. v n - u n)  0"
  shows "convergent v" "lim v = lim u"
proof -
  have "(λn. u n + (v n - u n))  lim u + 0"
    apply (rule tendsto_add) using assms convergent_LIMSEQ_iff by auto
  then have *: "v  lim u" by auto
  show "convergent v" using * by (simp add: Lim_def convergentI)
  show "lim v = lim u" using * by (simp add: limI)
qed

text ‹Let us now prove that the metric completion is a metric space: the distance between two
Cauchy sequences is the limit of the distances of points in the sequence. The convergence follows
from Lemma~\verb+convergent_Cauchy_dist+ above.›

instantiation metric_completion :: (metric_space) metric_space
begin

lift_definition dist_metric_completion::"('a::metric_space) metric_completion  'a metric_completion  real"
  is "λx y. lim (λn. dist (x n) (y n))"
proof -
  fix x y z t::"nat  'a" assume H: "Cauchy x  Cauchy y  (λn. dist (x n) (y n))  0"
                                     "Cauchy z  Cauchy t  (λn. dist (z n) (t n))  0"
  show "lim (λn. dist (x n) (z n)) = lim (λn. dist (y n) (t n))"
  proof (rule convergent_add_null(2))
    show "convergent (λn. dist (y n) (t n))"
      apply (rule convergent_Cauchy_dist) using H by auto

    have a: "(λn. - dist (t n) (z n) - dist (x n) (y n))  -0 -0"
      apply (intro tendsto_intros) using H by (auto simp add: dist_commute)
    have b:"(λn. dist (t n) (z n) + dist (x n) (y n))  0 + 0"
      apply (rule tendsto_add) using H by (auto simp add: dist_commute)
    have I: "dist (x n) (z n)  dist (t n) (y n) + (dist (t n) (z n) + dist (x n) (y n))" for n
      using dist_triangle[of "x n" "z n" "y n"] dist_triangle[of "y n" "z n" "t n"]
      by (auto simp add: dist_commute add.commute)
    show "(λn. dist (x n) (z n) - dist (y n) (t n))  0"
      apply (rule tendsto_sandwich[of "λn. -(dist (x n) (y n) + dist (z n) (t n))" _ _ "λn. dist (x n) (y n) + dist (z n) (t n)"])
      apply (auto intro!: always_eventually simp add: algebra_simps dist_commute I)
      apply (meson add_left_mono dist_triangle3 dist_triangle_le)
      using a b by auto
  qed
qed

lemma dist_metric_completion_limit:
  fixes x y::"'a metric_completion"
  shows "(λn. dist (rep_metric_completion x n) (rep_metric_completion y n))  dist x y"
proof -
  have C: "Cauchy (rep_metric_completion x)" "Cauchy (rep_metric_completion y)"
    using Quotient3_metric_completion Quotient3_rep_reflp by fastforce+
  show ?thesis
    unfolding dist_metric_completion_def using C apply auto
    using convergent_Cauchy_dist[OF C] convergent_LIMSEQ_iff by force
qed

lemma dist_metric_completion_limit':
  fixes x y::"nat  'a"
  assumes "Cauchy x" "Cauchy y"
  shows "(λn. dist (x n) (y n))  dist (abs_metric_completion x) (abs_metric_completion y)"
apply (subst dist_metric_completion.abs_eq)
using assms convergent_Cauchy_dist[OF assms] by (auto simp add: convergent_LIMSEQ_iff)

text ‹To define a metric space in the current library of Isabelle/HOL, one should also introduce
a uniformity structure and a topology, as follows (they are prescribed by the distance):›

definition uniformity_metric_completion::"(('a metric_completion) × ('a metric_completion)) filter"
  where "uniformity_metric_completion = (INF e{0 <..}. principal {(x, y). dist x y < e})"

definition open_metric_completion :: "'a metric_completion set  bool"
  where "open_metric_completion U = (xU. eventually (λ(x', y). x' = x  y  U) uniformity)"

instance proof
  fix x y::"'a metric_completion"
  have C: "Cauchy (rep_metric_completion x)" "Cauchy (rep_metric_completion y)"
    using Quotient3_metric_completion Quotient3_rep_reflp by fastforce+
  show "(dist x y = 0) = (x = y)"
    apply (subst Quotient3_rel_rep[OF Quotient3_metric_completion, symmetric])
    unfolding dist_metric_completion_def using C apply auto
    using convergent_Cauchy_dist[OF C] convergent_LIMSEQ_iff apply force
    by (simp add: limI)
next
  fix x y z::"'a metric_completion"
  have a: "(λn. dist (rep_metric_completion x n) (rep_metric_completion y n))  dist x y"
    using dist_metric_completion_limit by auto
  have b: "(λn. dist (rep_metric_completion x n) (rep_metric_completion z n) + dist (rep_metric_completion y n) (rep_metric_completion z n))
       dist x z + dist y z"
    apply (rule tendsto_add) using dist_metric_completion_limit by auto
  show "dist x y  dist x z + dist y z"
    by (rule LIMSEQ_le[OF a b], rule exI[of _ 0], auto simp add: dist_triangle2)
qed (auto simp add: uniformity_metric_completion_def open_metric_completion_def)
end

text ‹Let us now show that the distance thus defined on the metric completion is indeed complete.
This is essentially by design.›

instance metric_completion :: (metric_space) complete_space
proof
  fix X::"nat  'a metric_completion" assume "Cauchy X"
  have *: "N. n  N. dist (rep_metric_completion (X k) N) (rep_metric_completion (X k) n) < (1/Suc k)" for k
  proof -
    have "Cauchy (rep_metric_completion (X k))"
      using Quotient3_metric_completion Quotient3_rep_reflp by fastforce+
    then have "N. m  N. n  N. dist (rep_metric_completion (X k) m) (rep_metric_completion (X k) n) < (1/Suc k)"
      unfolding Cauchy_def by auto
    then show ?thesis by auto
  qed
  have "N. k. n  N k. dist (rep_metric_completion (X k) (N k)) (rep_metric_completion (X k) n) < (1/Suc k)"
    apply (rule choice) using * by auto
  then obtain N::"nat  nat" where
    N: "dist (rep_metric_completion (X k) (N k)) (rep_metric_completion (X k) n) < (1/Suc k)" if "n  N k" for n k
    by auto
  define u where "u = (λk. rep_metric_completion (X k) (N k))"

  have "Cauchy u"
  proof (rule metric_CauchyI)
    fix e::real assume "e > 0"
    obtain K::nat where "K > 4/e" using reals_Archimedean2 by blast
    obtain L::nat where L: "m  L. n  L. dist (X m) (X n) < e/2"
      using metric_CauchyD[OF ‹Cauchy X, of "e/2"] e > 0 by auto
    {
      fix m n assume "m  max K L" "n  max K L"
      then have "dist (X m) (X n) < e/2" using L by auto
      then have "eventually (λp. dist (rep_metric_completion (X m) p) (rep_metric_completion (X n) p) < e/2) sequentially"
        using dist_metric_completion_limit[of "X m" "X n"] by (metis order_tendsto_iff)
      then obtain p where p: "p  max (N m) (N n)" "dist (rep_metric_completion (X m) p) (rep_metric_completion (X n) p) < e/2"
        using eventually_False_sequentially eventually_elim2 eventually_ge_at_top by blast
      have "dist (u m) (rep_metric_completion (X m) p) < 1 / real (Suc m)"
        unfolding u_def using N[of m p] p(1) by auto
      also have "... < e/4"
        using m  max K L K > 4/e e > 0 apply (auto simp add: divide_simps algebra_simps)
        by (metis leD le_less_trans less_add_same_cancel2 linear of_nat_le_iff mult_le_cancel_iff2)
      finally have Im: "dist (u m) (rep_metric_completion (X m) p) < e/4" by simp
      have "dist (u n) (rep_metric_completion (X n) p) < 1 / real (Suc n)"
        unfolding u_def using N[of n p] p(1) by auto
      also have "... < e/4"
        using n  max K L K > 4/e e > 0 apply (auto simp add: divide_simps algebra_simps)
        by (metis leD le_less_trans less_add_same_cancel2 linear of_nat_le_iff mult_le_cancel_iff2)
      finally have In: "dist (u n) (rep_metric_completion (X n) p) < e/4" by simp

      have "dist (u m) (u n)  dist (u m) (rep_metric_completion (X m) p)
          + dist (rep_metric_completion (X m) p) (rep_metric_completion (X n) p) + dist (rep_metric_completion (X n) p) (u n)"
        by (metis add.commute add_left_mono dist_commute dist_triangle_le dist_triangle)
      also have "... < e/4 + e/2 + e/4"
        using In Im p(2) by (simp add: dist_commute)
      also have "... = e" by auto
      finally have "dist (u m) (u n) < e" by auto
    }
    then show "M. m  M. n  M. dist (u m) (u n) < e" by meson
  qed
  have *: "(λn. dist (abs_metric_completion u) (X n))  0"
  proof (rule order_tendstoI, auto simp add: less_le_trans eventually_sequentially)
    fix e::real assume "e > 0"
    obtain K::nat where "K > 4/e" using reals_Archimedean2 by blast
    obtain L::nat where L: "m  L. n  L. dist (u m) (u n) < e/4"
      using metric_CauchyD[OF ‹Cauchy u, of "e/4"] e > 0 by auto
    {
      fix n assume n: "n  max K L"
      {
        fix p assume p: "p  max (N n) L"
        have "dist (u n) (rep_metric_completion (X n) p) < 1/(Suc n)"
          unfolding u_def using N p by simp
        also have "... < e/4"
          using n  max K L K > 4/e e > 0 apply (auto simp add: divide_simps algebra_simps)
          by (metis leD le_less_trans less_add_same_cancel2 linear of_nat_le_iff mult_le_cancel_iff2)
        finally have *: "dist (u n) (rep_metric_completion (X n) p) < e/4"
          by fastforce

        have "dist (u p) (rep_metric_completion (X n) p)  dist (u p) (u n) + dist (u n) (rep_metric_completion (X n) p)"
          using dist_triangle by auto
        also have "... < e/4 + e/4" using * L n p by force
        finally have "dist (u p) (rep_metric_completion (X n) p)  e/2" by auto
      }
      then have A: "eventually (λp. dist (u p) (rep_metric_completion (X n) p)  e/2) sequentially"
        using eventually_at_top_linorder by blast
      have B: "(λp. dist (u p) (rep_metric_completion (X n) p))  dist (abs_metric_completion u) (X n)"
        using dist_metric_completion_limit'[OF ‹Cauchy u, of "rep_metric_completion (X n)"]
        unfolding Quotient3_abs_rep[OF Quotient3_metric_completion, of "X n"]
        using Quotient3_rep_reflp[OF Quotient3_metric_completion] by auto
      have "dist (abs_metric_completion u) (X n)  e/2"
        apply (rule LIMSEQ_le_const2[OF B]) using A unfolding eventually_sequentially by auto
      then have "dist (abs_metric_completion u) (X n) < e" using e > 0 by auto
    }
    then show "N. n  N. dist (abs_metric_completion u) (X n) < e"
      by blast
  qed
  have "X  abs_metric_completion u"
    apply (rule tendstoI) using * by (auto simp add: order_tendsto_iff dist_commute)
  then show "convergent X" unfolding convergent_def by auto
qed

subsection ‹Isometric embedding of a space in its metric completion›

text ‹The canonical embedding of a space into its metric completion is obtained by taking
the Cauchy sequence which is constant, equal to the given point. This is indeed an isometric
embedding with dense image, as we prove in the lemmas below.›

definition to_metric_completion::"('a::metric_space)  'a metric_completion"
  where "to_metric_completion x = abs_metric_completion (λn. x)"

lemma to_metric_completion_isometry:
  "isometry_on UNIV to_metric_completion"
proof (rule isometry_onI)
  fix x y::'a
  have "(λn. dist (x) (y))  dist (to_metric_completion x) (to_metric_completion y)"
    unfolding to_metric_completion_def apply (rule dist_metric_completion_limit')
    unfolding Cauchy_def by auto
  then show "dist (to_metric_completion x) (to_metric_completion y) = dist x y"
    by (simp add: LIMSEQ_const_iff)
qed

lemma to_metric_completion_dense:
  assumes "open U" "U  {}"
  shows "x. to_metric_completion x  U"
proof -
  obtain y where "y  U" using U  {} by auto
  obtain e::real where e: "e > 0" "z. dist z y < e  z  U"
    using y  U ‹open U by (metis open_dist)
  have *: "Cauchy (rep_metric_completion y)"
    using Quotient3_metric_completion Quotient3_rep_reflp by fastforce
  then obtain N where N: "n  N. m  N. dist (rep_metric_completion y n) (rep_metric_completion y m) < e/2"
    using e > 0 unfolding Cauchy_def by (meson divide_pos_pos zero_less_numeral)
  define x where "x = rep_metric_completion y N"
  have "(λn. dist x (rep_metric_completion y n))  dist (to_metric_completion x) (abs_metric_completion (rep_metric_completion y))"
    unfolding to_metric_completion_def apply (rule dist_metric_completion_limit')
    using * unfolding Cauchy_def by auto
  then have "(λn. dist x (rep_metric_completion y n))  dist (to_metric_completion x) y"
    unfolding Quotient3_abs_rep[OF Quotient3_metric_completion] by simp
  moreover have "eventually (λn. dist x (rep_metric_completion y n)  e/2) sequentially"
    unfolding eventually_sequentially x_def apply (rule exI[of _ N]) using N less_imp_le by auto
  ultimately have "dist (to_metric_completion x) y  e/2"
    using LIMSEQ_le_const2 unfolding eventually_sequentially by metis
  then have "to_metric_completion x  U"
    using e by auto
  then show ?thesis by auto
qed

lemma to_metric_completion_dense':
  "closure (range to_metric_completion) = UNIV"
apply (auto simp add: closure_iff_nhds_not_empty) using to_metric_completion_dense by fastforce

text ‹The main feature of the completion is that a uniformly continuous function on the original space can be extended
to a uniformly continuous function on the completion, i.e., it can be written as the composition of
a new function and of the inclusion \verb+to_metric_completion+.›

lemma lift_to_metric_completion:
  fixes f::"('a::metric_space)  ('b::complete_space)"
  assumes "uniformly_continuous_on UNIV f"
  shows "g. (uniformly_continuous_on UNIV g)
             (f = g o to_metric_completion)
             (x  range to_metric_completion. g x = f (inv to_metric_completion x))"
proof -
  define I::"'a metric_completion  'a" where "I = inv to_metric_completion"
  have "uniformly_continuous_on (range to_metric_completion) I"
    using isometry_on_uniformly_continuous[OF isometry_on_inverse(1)[OF to_metric_completion_isometry]] I_def
    by auto
  then have UC: "uniformly_continuous_on (range to_metric_completion) (λx. f (I x))"
    using assms uniformly_continuous_on_compose
    by (metis I_def bij_betw_imp_surj_on bij_betw_inv_into isometry_on_inverse(4) to_metric_completion_isometry)
  obtain g where g: "uniformly_continuous_on (closure(range to_metric_completion)) g"
                    "x. x  range to_metric_completion  f (I x) = g x"
    using uniformly_continuous_on_extension_on_closure[OF UC] by metis
  have "uniformly_continuous_on UNIV g"
    using to_metric_completion_dense' g(1) by metis
  moreover have "f x = g (to_metric_completion x)" for x
    using g(2) by (metis I_def UNIV_I isometry_on_inverse(2) range_eqI to_metric_completion_isometry)
  moreover have "g x = f (inv to_metric_completion x)" if "x  range to_metric_completion" for x
    using I_def g(2) that by auto
  ultimately show ?thesis unfolding comp_def by auto
qed

text ‹When the function is an isometry, the lifted function is also an isometry (and its range is
the closure of the range of the original function).
This shows that the metric completion is unique, up to isometry:›

lemma lift_to_metric_completion_isometry:
  fixes f::"('a::metric_space)  ('b::complete_space)"
  assumes "isometry_on UNIV f"
  shows "g. isometry_on UNIV g
           range g = closure(range f)
           f = g o to_metric_completion
           (x  range to_metric_completion. g x = f (inv to_metric_completion x))"
proof -
  have *: "uniformly_continuous_on UNIV f" using assms isometry_on_uniformly_continuous by force
  obtain g where g: "uniformly_continuous_on UNIV g"
                    "f = g o to_metric_completion"
                    "x. x  range to_metric_completion  g x = f (inv to_metric_completion x)"
    using lift_to_metric_completion[OF *] by blast
  have *: "isometry_on (range to_metric_completion) g"
    apply (rule isometry_on_cong[OF _ g(3)], rule isometry_on_compose[of _ _ f])
    using assms isometry_on_inverse[OF to_metric_completion_isometry] isometry_on_subset by (auto) (fastforce)
  then have "isometry_on UNIV g"
    unfolding to_metric_completion_dense'[symmetric] apply (rule isometry_on_closure)
    using continuous_on_subset[OF uniformly_continuous_imp_continuous[OF g(1)]] by auto

  have "g`(range to_metric_completion)  range f"
    using g unfolding comp_def by auto
  moreover have "g`(closure (range to_metric_completion))  closure (g`(range to_metric_completion))"
    using uniformly_continuous_imp_continuous[OF g(1)]
    by (meson closed_closure closure_subset continuous_on_subset image_closure_subset top_greatest)
  ultimately have "range g  closure (range f)"
    unfolding to_metric_completion_dense' by (simp add: g(2) image_comp)

  have "range f  range g"
    using g(2) by auto
  moreover have "closed (range g)"
    using isometry_on_complete_image[OF ‹isometry_on UNIV g] by (simp add: complete_eq_closed)
  ultimately have "closure (range f)  range g"
    by (simp add: closure_minimal)
  then have "range g = closure (range f)"
    using ‹range g  closure (range f) by auto
  then show ?thesis using ‹isometry_on UNIV g g by metis
qed

subsection ‹The metric completion of a second countable space is second countable›

text ‹We want to show that the metric completion of a second countable space is still
second countable. This is most easily expressed using the fact that a metric
space is second countable if and only if there exists a dense countable subset. We prove
the equivalence in the next lemma, and use it then to prove that the metric completion is
still second countable.›

lemma second_countable_iff_dense_countable_subset:
  "(B::'a::metric_space set set. countable B  topological_basis B)
     (A::'a set. countable A  closure A = UNIV)"
proof
  assume "B::'a set set. countable B  topological_basis B"
  then obtain B::"'a set set" where "countable B" "topological_basis B" by auto
  define A where "A = (λU. SOME x. x  U)`B"
  have "countable A" unfolding A_def using ‹countable B by auto
  moreover have "closure A = UNIV"
  proof (auto simp add: closure_approachable)
    fix x::'a and e::real assume "e > 0"
    obtain U where "U  B" "x  U" "U  ball x e"
      by (rule topological_basisE[OF ‹topological_basis B, of "ball x e" x], auto simp add: e > 0)
    define y where "y = (λU. SOME x. x  U) U"
    have "y  U" unfolding y_def using x  U some_in_eq by fastforce
    then have "dist y x < e"
      using U  ball x e by (metis dist_commute mem_ball subset_iff)
    moreover have "y  A" unfolding A_def y_def using U  B by auto
    ultimately show "yA. dist y x < e" by auto
  qed
  ultimately show "A::'a set. countable A  closure A = UNIV" by auto
next
  assume "A::'a set. countable A  closure A = UNIV"
  then obtain A::"'a set" where "countable A" "closure A = UNIV" by auto
  define B where "B = (λ(x, (n::nat)). ball x (1/n))`(A × UNIV)"
  have "countable B" unfolding B_def using ‹countable A by auto
  moreover have "topological_basis B"
  proof (rule topological_basisI)
    fix x::'a and U assume "x  U" "open U"
    then obtain e where "e > 0" "ball x e  U"
      using openE by blast
    obtain n::nat where "n > 2/e" using reals_Archimedean2 by auto
    then have "n > 0" using e > 0 not_less by fastforce
    then have "1/n > 0" using zero_less_divide_iff by fastforce
    then obtain y where y: "y  A" "dist x y < 1/n"
      by (metis ‹closure A = UNIV› UNIV_I closure_approachable dist_commute)
    then have "ball y (1/n)  B" unfolding B_def by auto
    moreover have "x  ball y (1/n)" using y(2) by (auto simp add: dist_commute)
    moreover have "ball y (1/n)  U"
    proof (auto)
      fix z assume z: "dist y z < 1/n"
      have "dist z x  dist z y + dist y x" using dist_triangle by auto
      also have "... < 1/n + 1/n" using z y(2) by (auto simp add: dist_commute)
      also have "... < e"
        using n > 2/e e > 0 n > 0 by (auto simp add: divide_simps mult.commute)
      finally have "z  ball x e" by (auto simp add: dist_commute)
      then show "z  U" using ‹ball x e  U by auto
    qed
    ultimately show "VB. x  V  V  U" by metis
  qed (auto simp add: B_def)
  ultimately show "B::'a set set. countable B  topological_basis B" by auto
qed

lemma second_countable_metric_dense_subset:
  "A::'a::{metric_space, second_countable_topology} set. countable A  closure A = UNIV"
using ex_countable_basis by (auto simp add: second_countable_iff_dense_countable_subset[symmetric])

instance metric_completion::("{metric_space, second_countable_topology}") second_countable_topology
proof
  obtain A::"'a set" where "countable A" "closure A = UNIV"
    using second_countable_metric_dense_subset by auto
  define Ab where "Ab = to_metric_completion`A"
  have "range to_metric_completion  closure Ab"
    unfolding Ab_def
    by (metis ‹closure A = UNIV› isometry_on_continuous[OF to_metric_completion_isometry] closed_closure closure_subset image_closure_subset)
  then have "closure Ab = UNIV"
    by (metis (no_types) to_metric_completion_dense'[symmetric] ‹range to_metric_completion  closure Ab closure_closure closure_mono top.extremum_uniqueI)
  moreover have "countable Ab" unfolding Ab_def using ‹countable A by auto
  ultimately have "Ab::'a metric_completion set. countable Ab  closure Ab = UNIV"
    by auto
  then show "B::'a metric_completion set set. countable B  open = generate_topology B"
    using second_countable_iff_dense_countable_subset topological_basis_imp_subbasis by auto
qed

instance metric_completion::("{metric_space, second_countable_topology}") polish_space
by standard

end (*of theory Metric_Completion*)

Theory Gromov_Hyperbolicity

(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
    License: BSD
*)

section ‹Gromov hyperbolic spaces›

theory Gromov_Hyperbolicity
  imports Isometries Metric_Completion
begin

subsection ‹Definition, basic properties›

text ‹Although we will mainly work with type classes later on, we introduce the definition
of hyperbolicity on subsets of a metric space.

A set is $\delta$-hyperbolic if it satisfies the following inequality. It is very obscure at first sight,
but we will see several equivalent characterizations later on. For instance, a space is hyperbolic
(maybe for a different constant $\delta$) if all geodesic triangles are thin, i.e., every side is
close to the union of the two other sides. This definition captures the main features of negative
curvature at a large scale, and has proved extremely fruitful and influential.

Two important references on this topic are~\cite{ghys_hyperbolique} and~\cite{bridson_haefliger}.
We will sometimes follow them, sometimes depart from them.›

definition Gromov_hyperbolic_subset::"real  ('a::metric_space) set  bool"
  where "Gromov_hyperbolic_subset delta A = (xA. yA. zA. tA. dist x y + dist z t  max (dist x z + dist y t) (dist x t + dist y z) + 2 * delta)"

lemma Gromov_hyperbolic_subsetI [intro]:
  assumes "x y z t. x  A  y  A  z  A  t  A  dist x y + dist z t  max (dist x z + dist y t) (dist x t + dist y z) + 2 * delta"
  shows "Gromov_hyperbolic_subset delta A"
using assms unfolding Gromov_hyperbolic_subset_def by auto

text ‹When the four points are not all distinct, the above inequality is always satisfied for
$\delta = 0$.›

lemma Gromov_hyperbolic_ineq_not_distinct:
  assumes "x = y  x = z  x = t  y = z  y = t  z = (t::'a::metric_space)"
  shows "dist x y + dist z t  max (dist x z + dist y t) (dist x t + dist y z)"
using assms by (auto simp add: dist_commute, simp add: dist_triangle add.commute, simp add: dist_triangle3)

text ‹It readily follows from the definition that hyperbolicity passes to the closure of the set.›

lemma Gromov_hyperbolic_closure:
  assumes "Gromov_hyperbolic_subset delta A"
  shows "Gromov_hyperbolic_subset delta (closure A)"
unfolding Gromov_hyperbolic_subset_def proof (auto)
  fix x y z t assume H: "x  closure A" "y  closure A" "z  closure A" "t  closure A"
  obtain X::"nat  'a" where X: "n. X n  A" "X  x"
    using H closure_sequential by blast
  obtain Y::"nat  'a" where Y: "n. Y n  A" "Y  y"
    using H closure_sequential by blast
  obtain Z::"nat  'a" where Z: "n. Z n  A" "Z  z"
    using H closure_sequential by blast
  obtain T::"nat  'a" where T: "n. T n  A" "T  t"
    using H closure_sequential by blast
  have *: "max (dist (X n) (Z n) + dist (Y n) (T n)) (dist (X n) (T n) + dist (Y n) (Z n)) + 2 * delta - dist (X n) (Y n) - dist (Z n) (T n)  0" for n
    using assms X(1)[of n] Y(1)[of n] Z(1)[of n] T(1)[of n] unfolding Gromov_hyperbolic_subset_def
    by (auto simp add: algebra_simps)
  have **: "(λn. max (dist (X n) (Z n) + dist (Y n) (T n)) (dist (X n) (T n) + dist (Y n) (Z n)) + 2 * delta - dist (X n) (Y n) - dist (Z n) (T n))
     max (dist x z + dist y t) (dist x t + dist y z) + 2 * delta - dist x y - dist z t"
    apply (auto intro!: tendsto_intros) using X Y Z T by auto
  have "max (dist x z + dist y t) (dist x t + dist y z) + 2 * delta - dist x y - dist z t  0"
    apply (rule LIMSEQ_le_const[OF **]) using * by auto
  then show "dist x y + dist z t  max (dist x z + dist y t) (dist x t + dist y z) + 2 * delta"
    by auto
qed

text ‹A good formulation of hyperbolicity is in terms of Gromov products. Intuitively, the
Gromov product of $x$ and $y$ based at $e$ is the distance between $e$ and the geodesic between
$x$ and $y$. It is also the time after which the geodesics from $e$ to $x$ and from $e$ to $y$
stop travelling together.›

definition Gromov_product_at::"('a::metric_space)  'a  'a  real"
  where "Gromov_product_at e x y = (dist e x + dist e y - dist x y) / 2"

lemma Gromov_hyperbolic_subsetI2:
  fixes delta::real
  assumes "e x y z. e  A  x  A  y  A  z  A  Gromov_product_at (e::'a::metric_space) x z  min (Gromov_product_at e x y) (Gromov_product_at e y z) - delta"
  shows "Gromov_hyperbolic_subset delta A"
proof (rule Gromov_hyperbolic_subsetI)
  fix x y z t assume H: "x  A" "z  A" "y  A" "t  A"
  show "dist x y + dist z t  max (dist x z + dist y t) (dist x t + dist y z) + 2 * delta"
    using assms[OF H] unfolding Gromov_product_at_def min_def max_def
    by (auto simp add: divide_simps algebra_simps dist_commute)
qed

lemma Gromov_product_nonneg [simp, mono_intros]:
  "Gromov_product_at e x y  0"
unfolding Gromov_product_at_def by (simp add: dist_triangle3)

lemma Gromov_product_commute:
  "Gromov_product_at e x y = Gromov_product_at e y x"
unfolding Gromov_product_at_def by (auto simp add: dist_commute)

lemma Gromov_product_le_dist [simp, mono_intros]:
  "Gromov_product_at e x y  dist e x"
  "Gromov_product_at e x y  dist e y"
unfolding Gromov_product_at_def by (auto simp add: diff_le_eq dist_triangle dist_triangle2)

lemma Gromov_product_le_infdist [mono_intros]:
  assumes "geodesic_segment_between G x y"
  shows "Gromov_product_at e x y  infdist e G"
proof -
  have [simp]: "G  {}" using assms by auto
  have "Gromov_product_at e x y  dist e z" if "z  G" for z
  proof -
    have "dist e x + dist e y  (dist e z + dist z x) + (dist e z + dist z y)"
      by (intro add_mono dist_triangle)
    also have "... = 2 * dist e z + dist x y"
      apply (auto simp add: dist_commute) using z  G assms by (metis dist_commute geodesic_segment_dist)
    finally show ?thesis unfolding Gromov_product_at_def by auto
  qed
  then show ?thesis
    apply (subst infdist_notempty) by (auto intro: cINF_greatest)
qed

lemma Gromov_product_add:
  "Gromov_product_at e x y + Gromov_product_at x e y = dist e x"
unfolding Gromov_product_at_def by (auto simp add: algebra_simps divide_simps dist_commute)

lemma Gromov_product_geodesic_segment:
  assumes "geodesic_segment_between G x y" "t  {0..dist x y}"
  shows "Gromov_product_at x y (geodesic_segment_param G x t) = t"
proof -
  have "dist x (geodesic_segment_param G x t) = t"
    using assms(1) assms(2) geodesic_segment_param(6) by auto
  moreover have "dist y (geodesic_segment_param G x t) = dist x y - t"
    by (metis ‹dist x (geodesic_segment_param G x t) = t add_diff_cancel_left' assms(1) assms(2) dist_commute geodesic_segment_dist geodesic_segment_param(3))
  ultimately show ?thesis unfolding Gromov_product_at_def by auto
qed

lemma Gromov_product_e_x_x [simp]:
  "Gromov_product_at e x x = dist e x"
unfolding Gromov_product_at_def by auto

lemma Gromov_product_at_diff:
  "¦Gromov_product_at x y z - Gromov_product_at a b c¦  dist x a + dist y b + dist z c"
unfolding Gromov_product_at_def abs_le_iff apply (auto simp add: divide_simps)
by (smt dist_commute dist_triangle4)+

lemma Gromov_product_at_diff1:
  "¦Gromov_product_at a x y - Gromov_product_at b x y¦  dist a b"
using Gromov_product_at_diff[of a x y b x y] by auto

lemma Gromov_product_at_diff2:
  "¦Gromov_product_at e x z - Gromov_product_at e y z¦  dist x y"
using Gromov_product_at_diff[of e x z e y z] by auto

lemma Gromov_product_at_diff3:
  "¦Gromov_product_at e x y - Gromov_product_at e x z¦  dist y z"
using Gromov_product_at_diff[of e x y e x z] by auto

text ‹The Gromov product is continuous in its three variables. We formulate it in terms of sequences,
as it is the way it will be used below (and moreover continuity for functions of several variables
is very poor in the library).›

lemma Gromov_product_at_continuous:
  assumes "(u  x) F" "(v  y) F" "(w  z) F"
  shows "((λn. Gromov_product_at (u n) (v n) (w n))  Gromov_product_at x y z) F"
proof -
  have "((λn. abs(Gromov_product_at (u n) (v n) (w n) - Gromov_product_at x y z))  0 + 0 + 0) F"
    apply (rule tendsto_sandwich[of "λn. 0" _ _ "λn. dist (u n) x + dist (v n) y + dist (w n) z", OF always_eventually always_eventually])
    apply (simp, simp add: Gromov_product_at_diff, simp, intro tendsto_intros)
    using assms tendsto_dist_iff by auto
  then show ?thesis
    apply (subst tendsto_dist_iff) unfolding dist_real_def by auto
qed


subsection ‹Typeclass for Gromov hyperbolic spaces›

text ‹We could (should?) just derive \verb+Gromov_hyperbolic_space+ from \verb+metric_space+.
However, in this case, properties of metric spaces are not available when working in the locale!
It is more efficient to ensure that we have a metric space by putting a type class restriction
in the definition. The $\delta$ in Gromov-hyperbolicity type class is called \verb+deltaG+ to
avoid name clashes.
›

class metric_space_with_deltaG = metric_space +
  fixes deltaG::"('a::metric_space) itself  real"

class Gromov_hyperbolic_space = metric_space_with_deltaG +
  assumes hyperb_quad_ineq0: "Gromov_hyperbolic_subset (deltaG(TYPE('a::metric_space))) (UNIV::'a set)"

class Gromov_hyperbolic_space_geodesic = Gromov_hyperbolic_space + geodesic_space

lemma (in Gromov_hyperbolic_space) hyperb_quad_ineq [mono_intros]:
  shows "dist x y + dist z t  max (dist x z + dist y t) (dist x t + dist y z) + 2 * deltaG(TYPE('a))"
using hyperb_quad_ineq0 unfolding Gromov_hyperbolic_subset_def by auto

text ‹It readily follows from the definition that the completion of a $\delta$-hyperbolic
space is still $\delta$-hyperbolic.›

instantiation metric_completion :: (Gromov_hyperbolic_space) Gromov_hyperbolic_space
begin
definition deltaG_metric_completion::"('a metric_completion) itself  real" where
  "deltaG_metric_completion _ = deltaG(TYPE('a))"

instance proof (standard, rule Gromov_hyperbolic_subsetI)
  have "Gromov_hyperbolic_subset (deltaG(TYPE('a))) (range (to_metric_completion::'a  _))"
    unfolding Gromov_hyperbolic_subset_def
    apply (auto simp add: isometry_onD[OF to_metric_completion_isometry])
    by (metis hyperb_quad_ineq)
  then have "Gromov_hyperbolic_subset (deltaG TYPE('a metric_completion)) (UNIV::'a metric_completion set)"
    unfolding deltaG_metric_completion_def to_metric_completion_dense'[symmetric]
    using Gromov_hyperbolic_closure by auto
  then show "dist x y + dist z t  max (dist x z + dist y t) (dist x t + dist y z) + 2 * deltaG TYPE('a metric_completion)"
      for x y z t::"'a metric_completion"
    unfolding Gromov_hyperbolic_subset_def by auto
qed
end (*of instantiation metric_completion (of Gromov_hyperbolic_space) is Gromov_hyperbolic*)


context Gromov_hyperbolic_space
begin

lemma delta_nonneg [simp, mono_intros]:
  "deltaG(TYPE('a))  0"
proof -
  obtain x::'a where True by auto
  show ?thesis using hyperb_quad_ineq[of x x x x] by auto
qed

lemma hyperb_ineq [mono_intros]:
  "Gromov_product_at (e::'a) x z  min (Gromov_product_at e x y) (Gromov_product_at e y z) - deltaG(TYPE('a))"
using hyperb_quad_ineq[of e y x z] unfolding Gromov_product_at_def min_def max_def
by (auto simp add: divide_simps algebra_simps metric_space_class.dist_commute)

lemma hyperb_ineq' [mono_intros]:
  "Gromov_product_at (e::'a) x z + deltaG(TYPE('a))  min (Gromov_product_at e x y) (Gromov_product_at e y z)"
using hyperb_ineq[of e x y z] by auto

lemma hyperb_ineq_4_points [mono_intros]:
  "Min {Gromov_product_at (e::'a) x y, Gromov_product_at e y z, Gromov_product_at e z t} - 2 * deltaG(TYPE('a))  Gromov_product_at e x t"
using hyperb_ineq[of e x y z] hyperb_ineq[of e x z t] apply auto using delta_nonneg by linarith

lemma hyperb_ineq_4_points' [mono_intros]:
  "Min {Gromov_product_at (e::'a) x y, Gromov_product_at e y z, Gromov_product_at e z t}  Gromov_product_at e x t + 2 * deltaG(TYPE('a))"
using hyperb_ineq_4_points[of e x y z t] by auto

text ‹In Gromov-hyperbolic spaces, geodesic triangles are thin, i.e., a point on one side of a
geodesic triangle is close to the union of the two other sides (where the constant in "close"
is $4\delta$, independent of the size of the triangle). We prove this basic property
(which, in fact, is a characterization of Gromov-hyperbolic spaces: a geodesic space in which
triangles are thin is hyperbolic).›

lemma thin_triangles1:
  assumes "geodesic_segment_between G x y" "geodesic_segment_between H x (z::'a)"
          "t  {0..Gromov_product_at x y z}"
  shows "dist (geodesic_segment_param G x t) (geodesic_segment_param H x t)  4 * deltaG(TYPE('a))"
proof -
  have *: "Gromov_product_at x z (geodesic_segment_param H x t) = t"
    apply (rule Gromov_product_geodesic_segment[OF assms(2)]) using assms(3) Gromov_product_le_dist(2)
    by (metis atLeastatMost_subset_iff subset_iff)
  have "Gromov_product_at x y (geodesic_segment_param H x t)
         min (Gromov_product_at x y z) (Gromov_product_at x z (geodesic_segment_param H x t)) - deltaG(TYPE('a))"
    by (rule hyperb_ineq)
  then have I: "Gromov_product_at x y (geodesic_segment_param H x t)  t - deltaG(TYPE('a))"
    using assms(3) unfolding * by auto

  have *: "Gromov_product_at x (geodesic_segment_param G x t) y = t"
    apply (subst Gromov_product_commute)
    apply (rule Gromov_product_geodesic_segment[OF assms(1)]) using assms(3) Gromov_product_le_dist(1)
    by (metis atLeastatMost_subset_iff subset_iff)
  have "t - 2 * deltaG(TYPE('a)) = min t (t- deltaG(TYPE('a))) - deltaG(TYPE('a))"
    unfolding min_def using antisym by fastforce
  also have "...  min (Gromov_product_at x (geodesic_segment_param G x t) y) (Gromov_product_at x y (geodesic_segment_param H x t)) - deltaG(TYPE('a))"
    using I * by auto
  also have "...  Gromov_product_at x (geodesic_segment_param G x t) (geodesic_segment_param H x t)"
    by (rule hyperb_ineq)
  finally have I: "Gromov_product_at x (geodesic_segment_param G x t) (geodesic_segment_param H x t)  t - 2 * deltaG(TYPE('a))"
    by simp

  have A: "dist x (geodesic_segment_param G x t) = t"
    by (meson assms(1) assms(3) atLeastatMost_subset_iff geodesic_segment_param(6) Gromov_product_le_dist(1) subset_eq)
  have B: "dist x (geodesic_segment_param H x t) = t"
    by (meson assms(2) assms(3) atLeastatMost_subset_iff geodesic_segment_param(6) Gromov_product_le_dist(2) subset_eq)
  show ?thesis
    using I unfolding Gromov_product_at_def A B by auto
qed

theorem thin_triangles:
  assumes "geodesic_segment_between Gxy x y"
          "geodesic_segment_between Gxz x z"
          "geodesic_segment_between Gyz y z"
          "(w::'a)  Gyz"
  shows "infdist w (Gxy  Gxz)  4 * deltaG(TYPE('a))"
proof -
  obtain t where w: "t  {0..dist y z}" "w = geodesic_segment_param Gyz y t"
    using geodesic_segment_param[OF assms(3)] assms(4) by (metis imageE)
  show ?thesis
  proof (cases "t  Gromov_product_at y x z")
    case True
    have *: "dist w (geodesic_segment_param Gxy y t)  4 * deltaG(TYPE('a))" unfolding w(2)
      apply (rule thin_triangles1[of _ _ z _ x])
      using True assms(1) assms(3) w(1) by (auto simp add: geodesic_segment_commute Gromov_product_commute)
    show ?thesis
      apply (rule infdist_le2[OF _ *])
      by (metis True assms(1) box_real(2) geodesic_segment_commute geodesic_segment_param(3) Gromov_product_le_dist(1) mem_box_real(2) order_trans subset_eq sup.cobounded1 w(1))
  next
    case False
    define s where "s = dist y z - t"
    have s: "s  {0..Gromov_product_at z y x}"
      unfolding s_def using Gromov_product_add[of y z x] w(1) False by (auto simp add: Gromov_product_commute)
    have w2: "w = geodesic_segment_param Gyz z s"
      unfolding s_def w(2) apply (rule geodesic_segment_reverse_param[symmetric]) using assms(3) w(1) by auto
    have *: "dist w (geodesic_segment_param Gxz z s)  4 * deltaG(TYPE('a))" unfolding w2
      apply (rule thin_triangles1[of _ _ y _ x])
      using s assms by (auto simp add: geodesic_segment_commute)
    show ?thesis
      apply (rule infdist_le2[OF _ *])
      by (metis Un_iff assms(2) atLeastAtMost_iff geodesic_segment_commute geodesic_segment_param(3) Gromov_product_commute Gromov_product_le_dist(1) order_trans s)
  qed
qed

text ‹A consequence of the thin triangles property is that, although the geodesic between
two points is in general not unique in a Gromov-hyperbolic space, two such geodesics are
within $O(\delta)$ of each other.›

lemma geodesics_nearby:
  assumes "geodesic_segment_between G x y" "geodesic_segment_between H x y"
          "(z::'a)  G"
  shows "infdist z H  4 * deltaG(TYPE('a))"
using thin_triangles[OF geodesic_segment_between_x_x(1) assms(2) assms(1) assms(3)]
geodesic_segment_endpoints(1)[OF assms(2)] insert_absorb by fastforce

text ‹A small variant of the property of thin triangles is that triangles are slim, i.e., there is
a point which is close to the three sides of the triangle (a "center" of the triangle, but
only defined up to $O(\delta)$). And one can take it on any side, and its distance to the corresponding
vertices is expressed in terms of a Gromov product.›

lemma slim_triangle:
  assumes "geodesic_segment_between Gxy x y"
          "geodesic_segment_between Gxz x z"
          "geodesic_segment_between Gyz y (z::'a)"
  shows "w. infdist w Gxy  4 * deltaG(TYPE('a)) 
             infdist w Gxz  4 * deltaG(TYPE('a)) 
             infdist w Gyz  4 * deltaG(TYPE('a)) 
             dist w x = (Gromov_product_at x y z)  w  Gxy"
proof -
  define w where "w = geodesic_segment_param Gxy x (Gromov_product_at x y z)"
  have "w  Gxy" unfolding w_def
    by (rule geodesic_segment_param(3)[OF assms(1)], auto)
  then have xy: "infdist w Gxy  4 * deltaG(TYPE('a))" by simp
  have *: "dist w x = (Gromov_product_at x y z)"
    unfolding w_def using assms(1)
    by (metis Gromov_product_le_dist(1) Gromov_product_nonneg atLeastAtMost_iff geodesic_segment_param(6) metric_space_class.dist_commute)

  define w2 where "w2 = geodesic_segment_param Gxz x (Gromov_product_at x y z)"
  have "w2  Gxz" unfolding w2_def
    by (rule geodesic_segment_param(3)[OF assms(2)], auto)
  moreover have "dist w w2  4 * deltaG(TYPE('a))"
    unfolding w_def w2_def by (rule thin_triangles1[OF assms(1) assms(2)], auto)
  ultimately have xz: "infdist w Gxz  4 * deltaG(TYPE('a))"
    using infdist_le2 by blast

  have "w = geodesic_segment_param Gxy y (dist x y - Gromov_product_at x y z)"
    unfolding w_def by (rule geodesic_segment_reverse_param[OF assms(1), symmetric], auto)
  then have w: "w = geodesic_segment_param Gxy y (Gromov_product_at y x z)"
    using Gromov_product_add[of x y z] by (metis add_diff_cancel_left')

  define w3 where "w3 = geodesic_segment_param Gyz y (Gromov_product_at y x z)"
  have "w3  Gyz" unfolding w3_def
    by (rule geodesic_segment_param(3)[OF assms(3)], auto)
  moreover have "dist w w3  4 * deltaG(TYPE('a))"
    unfolding w w3_def by (rule thin_triangles1[OF geodesic_segment_commute[OF assms(1)] assms(3)], auto)
  ultimately have yz: "infdist w Gyz  4 * deltaG(TYPE('a))"
    using infdist_le2 by blast

  show ?thesis using xy xz yz * w  Gxy by force
qed

text ‹The distance of a vertex of a triangle to the opposite side is essentially given by the
Gromov product, up to $2\delta$.›

lemma dist_triangle_side_middle:
  assumes "geodesic_segment_between G x (y::'a)"
  shows "dist z (geodesic_segment_param G x (Gromov_product_at x z y))  Gromov_product_at z x y + 2 * deltaG(TYPE('a))"
proof -
  define m where "m = geodesic_segment_param G x (Gromov_product_at x z y)"
  have "m  G"
    unfolding m_def using assms(1) by auto
  have A: "dist x m = Gromov_product_at x z y"
    unfolding m_def by (rule geodesic_segment_param(6)[OF assms(1)], auto)
  have B: "dist y m = dist x y - dist x m"
    using geodesic_segment_dist[OF assms m  G] by (auto simp add: metric_space_class.dist_commute)
  have *: "dist x z + dist y m = Gromov_product_at z x y + dist x y"
          "dist x m + dist y z = Gromov_product_at z x y + dist x y"
    unfolding B A Gromov_product_at_def by (auto simp add: metric_space_class.dist_commute divide_simps)

  have "dist x y + dist z m  max (dist x z + dist y m) (dist x m + dist y z) + 2 * deltaG(TYPE('a))"
    by (rule hyperb_quad_ineq)
  then have "dist z m  Gromov_product_at z x y + 2 * deltaG(TYPE('a))"
    unfolding * by auto
  then show ?thesis
    unfolding m_def by auto
qed

lemma infdist_triangle_side [mono_intros]:
  assumes "geodesic_segment_between G x (y::'a)"
  shows "infdist z G  Gromov_product_at z x y + 2 * deltaG(TYPE('a))"
proof -
  have "infdist z G  dist z (geodesic_segment_param G x (Gromov_product_at x z y))"
    using assms by (auto intro!: infdist_le)
  then show ?thesis
    using dist_triangle_side_middle[OF assms, of z] by auto
qed

text ‹The distance of a point on a side of triangle to the opposite vertex is controlled by
the length of the opposite sides, up to $\delta$.›

lemma dist_le_max_dist_triangle:
  assumes "geodesic_segment_between G x y"
          "m  G"
  shows "dist m z  max (dist x z) (dist y z) + deltaG(TYPE('a))"
proof -
  consider "dist m x  deltaG(TYPE('a))" | "dist m y  deltaG(TYPE('a))" |
           "dist m x  deltaG(TYPE('a))  dist m y  deltaG(TYPE('a))  Gromov_product_at z x m  Gromov_product_at z m y" |
           "dist m x  deltaG(TYPE('a))  dist m y  deltaG(TYPE('a))  Gromov_product_at z m y  Gromov_product_at z x m"
    by linarith
  then show ?thesis
  proof (cases)
    case 1
    have "dist m z  dist m x + dist x z"
      by (intro mono_intros)
    then show ?thesis using 1 by auto
  next
    case 2
    have "dist m z  dist m y + dist y z"
      by (intro mono_intros)
    then show ?thesis using 2 by auto
  next
    case 3
    then have "Gromov_product_at z x m = min (Gromov_product_at z x m) (Gromov_product_at z m y)"
      by auto
    also have "...  Gromov_product_at z x y + deltaG(TYPE('a))"
      by (intro mono_intros)
    finally have "dist z m  dist z y + dist x m - dist x y + 2 * deltaG(TYPE('a))"
      unfolding Gromov_product_at_def by (auto simp add: divide_simps algebra_simps)
    also have "... = dist z y - dist m y + 2 * deltaG(TYPE('a))"
      using geodesic_segment_dist[OF assms] by auto
    also have "...  dist z y + deltaG(TYPE('a))"
      using 3 by auto
    finally show ?thesis
      by (simp add: metric_space_class.dist_commute)
  next
    case 4
    then have "Gromov_product_at z m y = min (Gromov_product_at z x m) (Gromov_product_at z m y)"
      by auto
    also have "...  Gromov_product_at z x y + deltaG(TYPE('a))"
      by (intro mono_intros)
    finally have "dist z m  dist z x + dist m y - dist x y + 2 * deltaG(TYPE('a))"
      unfolding Gromov_product_at_def by (auto simp add: divide_simps algebra_simps)
    also have "... = dist z x - dist x m + 2 * deltaG(TYPE('a))"
      using geodesic_segment_dist[OF assms] by auto
    also have "...  dist z x + deltaG(TYPE('a))"
      using 4 by (simp add: metric_space_class.dist_commute)
    finally show ?thesis
      by (simp add: metric_space_class.dist_commute)
  qed
qed

end (* of locale Gromov_hyperbolic_space *)

text ‹A useful variation around the previous properties is that quadrilaterals are thin, in the
following sense: if one has a union of three geodesics from $x$ to $t$, then a geodesic from $x$
to $t$ remains within distance $8\delta$ of the union of these 3 geodesics. We formulate the
statement in geodesic hyperbolic spaces as the proof requires the construction of an additional
geodesic, but in fact the statement is true without this assumption, thanks to the Bonk-Schramm
extension theorem.›

lemma (in Gromov_hyperbolic_space_geodesic) thin_quadrilaterals:
  assumes "geodesic_segment_between Gxy x y"
          "geodesic_segment_between Gyz y z"
          "geodesic_segment_between Gzt z t"
          "geodesic_segment_between Gxt x t"
          "(w::'a)  Gxt"
  shows "infdist w (Gxy  Gyz  Gzt)  8 * deltaG(TYPE('a))"
proof -
  have I: "infdist w ({x--z}  Gzt)  4 * deltaG(TYPE('a))"
    apply (rule thin_triangles[OF _ assms(3) assms(4) assms(5)])
    by (simp add: geodesic_segment_commute)
  have "u  {x--z}  Gzt. infdist w ({x--z}  Gzt) = dist w u"
    apply (rule infdist_proper_attained, auto intro!: proper_Un simp add: geodesic_segment_topology(7))
    by (meson assms(3) geodesic_segmentI geodesic_segment_topology)
  then obtain u where u: "u  {x--z}  Gzt" "infdist w ({x--z}  Gzt) = dist w u"
    by auto
  have "infdist u (Gxy  Gyz  Gzt)  4 * deltaG(TYPE('a))"
  proof (cases "u  {x--z}")
    case True
    have "infdist u (Gxy  Gyz  Gzt)  infdist u (Gxy  Gyz)"
      apply (intro mono_intros) using assms(1) by auto
    also have "...  4 * deltaG(TYPE('a))"
      using thin_triangles[OF geodesic_segment_commute[OF assms(1)] assms(2) _ True] by auto
    finally show ?thesis
      by auto
  next
    case False
    then have *: "u  Gzt" using u(1) by auto
    have "infdist u (Gxy  Gyz  Gzt)  infdist u Gzt"
      apply (intro mono_intros) using assms(3) by auto
    also have "... = 0" using * by auto
    finally show ?thesis
      using local.delta_nonneg by linarith
  qed
  moreover have "infdist w (Gxy  Gyz  Gzt)  infdist u (Gxy  Gyz  Gzt) + dist w u"
    by (intro mono_intros)
  ultimately show ?thesis
    using I u(2) by auto
qed

text ‹There are converses to the above statements: if triangles are thin, or slim, then the space
is Gromov-hyperbolic, for some $\delta$. We prove these criteria here, following the proofs in
Ghys (with a simplification in the case of slim triangles.›

text ‹The basic result we will use twice below is the following: if points on sides of triangles
at the same distance of the basepoint are close to each other up to the Gromov product, then the
space is hyperbolic. The proof goes as follows. One wants to show that $(x,z)_e \geq
\min((x,y)_e, (y,z)_e) - \delta = t-\delta$. On $[ex]$, $[ey]$ and $[ez]$, consider points
$wx$, $wy$ and $wz$ at distance $t$ of $e$. Then $wx$ and $wy$ are $\delta$-close by assumption,
and so are $wy$ and $wz$. Then $wx$ and $wz$ are $2\delta$-close. One can use these two points
to express $(x,z)_e$, and the result follows readily.›

lemma (in geodesic_space) controlled_thin_triangles_implies_hyperbolic:
  assumes "(x::'a) y z t Gxy Gxz. geodesic_segment_between Gxy x y  geodesic_segment_between Gxz x z  t  {0..Gromov_product_at x y z}
       dist (geodesic_segment_param Gxy x t) (geodesic_segment_param Gxz x t)  delta"
  shows "Gromov_hyperbolic_subset delta (UNIV::'a set)"
proof (rule Gromov_hyperbolic_subsetI2)
  fix e x y z::'a
  define t where "t = min (Gromov_product_at e x y) (Gromov_product_at e y z)"
  define wx where "wx = geodesic_segment_param {e--x} e t"
  define wy where "wy = geodesic_segment_param {e--y} e t"
  define wz where "wz = geodesic_segment_param {e--z} e t"
  have "dist wx wy  delta"
    unfolding wx_def wy_def t_def by (rule assms[of _ _ x _ y], auto)
  have "dist wy wz  delta"
    unfolding wy_def wz_def t_def by (rule assms[of _ _ y _ z], auto)

  have "t + dist wy x = dist e wx + dist wy x"
    unfolding wx_def apply (auto intro!: geodesic_segment_param_in_geodesic_spaces(6)[symmetric])
    unfolding t_def by (auto, meson Gromov_product_le_dist(1) min.absorb_iff2 min.left_idem order.trans)
  also have "...  dist e wx + (dist wy wx + dist wx x)"
    by (intro mono_intros)
  also have "...  dist e wx + (delta + dist wx x)"
    using ‹dist wx wy  delta by (auto simp add: metric_space_class.dist_commute)
  also have "... = delta + dist e x"
    apply auto apply (rule geodesic_segment_dist[of "{e--x}"])
    unfolding wx_def t_def by (auto simp add: geodesic_segment_param_in_segment)
  finally have *: "t + dist wy x - delta  dist e x" by simp

  have "t + dist wy z = dist e wz + dist wy z"
    unfolding wz_def apply (auto intro!: geodesic_segment_param_in_geodesic_spaces(6)[symmetric])
    unfolding t_def by (auto, meson Gromov_product_le_dist(2) min.absorb_iff1 min.right_idem order.trans)
  also have "...  dist e wz + (dist wy wz + dist wz z)"
    by (intro mono_intros)
  also have "...  dist e wz + (delta + dist wz z)"
    using ‹dist wy wz  delta by (auto simp add: metric_space_class.dist_commute)
  also have "... = delta + dist e z"
    apply auto apply (rule geodesic_segment_dist[of "{e--z}"])
    unfolding wz_def t_def by (auto simp add: geodesic_segment_param_in_segment)
  finally have "t + dist wy z - delta  dist e z" by simp

  then have "(t + dist wy x - delta) + (t + dist wy z - delta)  dist e x + dist e z"
    using * by simp
  also have "... = dist x z + 2 * Gromov_product_at e x z"
    unfolding Gromov_product_at_def by (auto simp add: algebra_simps divide_simps)
  also have "...  dist wy x + dist wy z + 2 * Gromov_product_at e x z"
    using metric_space_class.dist_triangle[of x z wy] by (auto simp add: metric_space_class.dist_commute)
  finally have "2 * t - 2 * delta  2 * Gromov_product_at e x z"
    by auto
  then show "min (Gromov_product_at e x y) (Gromov_product_at e y z) - delta  Gromov_product_at e x z"
    unfolding t_def by auto
qed

text ‹We prove that if triangles are thin, i.e., they satisfy the Rips condition, i.e., every side
of a triangle is included in the $\delta$-neighborhood of the union of the other triangles, then
the space is hyperbolic. If a point $w$ on $[xy]$ satisfies $d(x,w) < (y,z)_x - \delta$, then its
friend on $[xz] \cup [yz]$ has to be on $[xz]$, and roughly at the same distance of the origin.
Then it follows that the point on $[xz]$ with $d(x,w') = d(x,w)$ is close to $w$, as desired.
If $d(x,w) \in [(y,z)_x - \delta, (y,z)_x)$, we argue in the same way but for the point which
is closer to $x$ by an amount $\delta$. Finally, the last case $d(x,w) = (y,z)_x$ follows by
continuity.›

proposition (in geodesic_space) thin_triangles_implies_hyperbolic:
  assumes "(x::'a) y z w Gxy Gyz Gxz. geodesic_segment_between Gxy x y  geodesic_segment_between Gxz x z  geodesic_segment_between Gyz y z
         w  Gxy  infdist w (Gxz  Gyz)  delta"
  shows "Gromov_hyperbolic_subset (4 * delta) (UNIV::'a set)"
proof -
  obtain x0::'a where True by auto
  have "infdist x0 ({x0}  {x0})  delta"
    by (rule assms[of "{x0}" x0 x0 "{x0}" x0 "{x0}" x0], auto)
  then have [simp]: "delta  0"
    using infdist_nonneg by auto

  have "dist (geodesic_segment_param Gxy x t) (geodesic_segment_param Gxz x t)  4 * delta"
    if H: "geodesic_segment_between Gxy x y" "geodesic_segment_between Gxz x z" "t  {0..Gromov_product_at x y z}"
    for x y z t Gxy Gxz
  proof -
    have Main: "dist (geodesic_segment_param Gxy x u) (geodesic_segment_param Gxz x u)  4 * delta"
      if "u  {delta..<Gromov_product_at x y z}" for u
    proof -
      define wy where "wy = geodesic_segment_param Gxy x (u-delta)"
      have "dist wy (geodesic_segment_param Gxy x u) = abs((u-delta) - u)"
        unfolding wy_def apply (rule geodesic_segment_param(7)[OF H(1)]) using that apply auto
        using Gromov_product_le_dist(1)[of x y z] delta  0 by linarith+
      then have I1: "dist wy (geodesic_segment_param Gxy x u) = delta" by auto

      have "infdist wy (Gxz  {y--z})  delta"
        unfolding wy_def apply (rule assms[of Gxy x y _ z]) using H by (auto simp add: geodesic_segment_param_in_segment)
      moreover have "wz  Gxz  {y--z}. infdist wy (Gxz  {y--z}) = dist wy wz"
        apply (rule infdist_proper_attained, intro proper_Un)
        using H(2) by (auto simp add: geodesic_segment_topology)
      ultimately obtain wz where wz: "wz  Gxz  {y--z}" "dist wy wz  delta"
        by force

      have "dist wz x  dist wz wy + dist wy x"
        by (rule metric_space_class.dist_triangle)
      also have "...  delta + (u-delta)"
        apply (intro add_mono) using wz(2) unfolding wy_def apply (auto simp add: metric_space_class.dist_commute)
        apply (intro eq_refl geodesic_segment_param(6)[OF H(1)])
        using that apply auto
        by (metis diff_0_right diff_mono dual_order.trans Gromov_product_le_dist(1) less_eq_real_def metric_space_class.dist_commute metric_space_class.zero_le_dist wy_def)
      finally have "dist wz x  u" by auto
      also have "... < Gromov_product_at x y z"
        using that by auto
      also have "...  infdist x {y--z}"
        by (rule Gromov_product_le_infdist, auto)
      finally have "dist x wz < infdist x {y--z}"
        by (simp add: metric_space_class.dist_commute)
      then have "wz  {y--z}"
        by (metis add.left_neutral infdist_triangle infdist_zero leD)
      then have "wz  Gxz"
        using wz by auto

      have "u - delta = dist x wy"
        unfolding wy_def apply (rule geodesic_segment_param(6)[symmetric, OF H(1)])
        using that apply auto
        using Gromov_product_le_dist(1)[of x y z] delta  0 by linarith
      also have "...  dist x wz + dist wz wy"
        by (rule metric_space_class.dist_triangle)
      also have "...  dist x wz + delta"
        using wz(2) by (simp add: metric_space_class.dist_commute)
      finally have "dist x wz  u - 2 * delta" by auto

      define dz where "dz = dist x wz"
      have *: "wz = geodesic_segment_param Gxz x dz"
        unfolding dz_def using wz  Gxz H(2) by auto
      have "dist wz (geodesic_segment_param Gxz x u) = abs(dz - u)"
        unfolding * apply (rule geodesic_segment_param(7)[OF H(2)])
        unfolding dz_def using ‹dist wz x  u that apply (auto simp add: metric_space_class.dist_commute)
        using Gromov_product_le_dist(2)[of x y z] delta  0 by linarith+
      also have "...  2 * delta"
        unfolding dz_def using ‹dist wz x  u ‹dist x wz  u - 2 * delta
        by (auto simp add: metric_space_class.dist_commute)
      finally have I3: "dist wz (geodesic_segment_param Gxz x u)  2 * delta"
        by simp

      have "dist (geodesic_segment_param Gxy x u) (geodesic_segment_param Gxz x u)
               dist (geodesic_segment_param Gxy x u) wy + dist wy wz + dist wz (geodesic_segment_param Gxz x u)"
        by (rule dist_triangle4)
      also have "...  delta + delta + (2 * delta)"
        using I1 wz(2) I3 by (auto simp add: metric_space_class.dist_commute)
      finally show ?thesis by simp
    qed
    have "t  {0..dist x y}" "t  {0..dist x z}" "t  0"
      using t  {0..Gromov_product_at x y z} apply auto
      using Gromov_product_le_dist[of x y z] by linarith+
    consider "t  delta" | "t  {delta..<Gromov_product_at x y z}" | "t = Gromov_product_at x y z  t > delta"
      using t  {0..Gromov_product_at x y z} by (auto, linarith)
    then show ?thesis
    proof (cases)
      case 1
      have "dist (geodesic_segment_param Gxy x t) (geodesic_segment_param Gxz x t)  dist x (geodesic_segment_param Gxy x t) + dist x (geodesic_segment_param Gxz x t)"
        by (rule metric_space_class.dist_triangle3)
      also have "... = t + t"
        using geodesic_segment_param(6)[OF H(1) t  {0..dist x y}] geodesic_segment_param(6)[OF H(2) t  {0..dist x z}]
        by auto
      also have "...  4 * delta" using 1 delta  0 by linarith
      finally show ?thesis by simp
    next
      case 2
      show ?thesis using Main[OF 2] by simp
    next
      case 3
      text ‹In this case, we argue by approximating $t$ by a slightly smaller parameter, for which
      the result has already been proved above. We need to argue that all functions are continuous
      on the sets we are considering, which is straightforward but tedious.›
      define u::"nat  real" where "u = (λn. t-1/n)"
      have "u  t - 0"
        unfolding u_def by (intro tendsto_intros)
      then have "u  t" by simp
      then have *: "eventually (λn. u n > delta) sequentially"
        using 3 by (auto simp add: order_tendsto_iff)
      have **: "eventually (λn. u n  0) sequentially"
        apply (rule eventually_elim2[OF *, of "(λn. delta  0)"]) apply auto
        using delta  0 by linarith
      have ***: "u n  t" for n unfolding u_def by auto
      have A: "eventually (λn. u n  {delta..<Gromov_product_at x y z}) sequentially"
        apply (auto intro!: eventually_conj)
        apply (rule eventually_mono[OF *], simp)
        unfolding u_def using 3 by auto
      have B: "eventually (λn. dist (geodesic_segment_param Gxy x (u n)) (geodesic_segment_param Gxz x (u n))  4 * delta) sequentially"
        by (rule eventually_mono[OF A Main], simp)
      have C: "(λn. dist (geodesic_segment_param Gxy x (u n)) (geodesic_segment_param Gxz x (u n)))
             dist (geodesic_segment_param Gxy x t) (geodesic_segment_param Gxz x t)"
        apply (intro tendsto_intros)
        apply (rule continuous_on_tendsto_compose[OF _ u  t t  {0..dist x y}])
        apply (simp add: isometry_on_continuous H(1))
        using ** *** t  {0..dist x y} apply (simp, intro eventually_conj, simp, meson dual_order.trans eventually_mono)
        apply (rule continuous_on_tendsto_compose[OF _ u  t t  {0..dist x z}])
        apply (simp add: isometry_on_continuous H(2))
        using ** *** t  {0..dist x z} apply (simp, intro eventually_conj, simp, meson dual_order.trans eventually_mono)
        done
      show ?thesis
        using B unfolding eventually_sequentially using LIMSEQ_le_const2[OF C] by simp
    qed
  qed
  with controlled_thin_triangles_implies_hyperbolic[OF this]
  show ?thesis by auto
qed

text ‹Then, we prove that if triangles are slim (i.e., there is a point that is $\delta$-close to
all sides), then the space is hyperbolic. Using the previous statement, we should show that points
on $[xy]$ and $[xz]$ at the same distance $t$ of the origin are close, if $t \leq (y,z)_x$.
There are two steps:
- for $t = (y,z)_x$, then the two points are in fact close to the middle of the triangle
(as this point satisfies $d(x,y) = d(x,w) + d(w,y) + O(\delta)$, and similarly for the other sides,
one gets readily $d(x,w) = (y,z)_w + O(\delta)$ by expanding the formula for the Gromov product).
Hence, they are close together.
- For $t < (y,z)_x$, we argue that there are points $y' \in [xy]$ and $z' \in [xz]$ for which
$t = (y',z')_x$, by a continuity argument and the intermediate value theorem.
Then the result follows from the first step in the triangle $xy'z'$.

The proof we give is simpler than the one in~\cite{ghys_hyperbolique}, and gives better constants.›

proposition (in geodesic_space) slim_triangles_implies_hyperbolic:
  assumes "(x::'a) y z Gxy Gyz Gxz. geodesic_segment_between Gxy x y  geodesic_segment_between Gxz x z  geodesic_segment_between Gyz y z
         w. infdist w Gxy  delta  infdist w Gxz  delta  infdist w Gyz  delta"
  shows "Gromov_hyperbolic_subset (6 * delta) (UNIV::'a set)"
proof -
  text ‹First step: the result is true for $t = (y,z)_x$.›
  have Main: "dist (geodesic_segment_param Gxy x (Gromov_product_at x y z)) (geodesic_segment_param Gxz x (Gromov_product_at x y z))  6 * delta"
    if H: "geodesic_segment_between Gxy x y" "geodesic_segment_between Gxz x z"
    for x y z Gxy Gxz
  proof -
    obtain w where w: "infdist w Gxy  delta" "infdist w Gxz  delta" "infdist w {y--z}  delta"
      using assms[OF H, of "{y--z}"] by auto
    have "wxy  Gxy. infdist w Gxy = dist w wxy"
      apply (rule infdist_proper_attained) using H(1) by (auto simp add: geodesic_segment_topology)
    then obtain wxy where wxy: "wxy  Gxy" "dist w wxy  delta"
      using w by auto
    have "wxz  Gxz. infdist w Gxz = dist w wxz"
      apply (rule infdist_proper_attained) using H(2) by (auto simp add: geodesic_segment_topology)
    then obtain wxz where wxz: "wxz  Gxz" "dist w wxz  delta"
      using w by auto
    have "wyz  {y--z}. infdist w {y--z} = dist w wyz"
      apply (rule infdist_proper_attained) by (auto simp add: geodesic_segment_topology)
    then obtain wyz where wyz: "wyz  {y--z}" "dist w wyz  delta"
      using w by auto

    have I: "dist wxy wxz  2 * delta" "dist wxy wyz  2 * delta" "dist wxz wyz  2 * delta"
      using metric_space_class.dist_triangle[of wxy wxz w] metric_space_class.dist_triangle[of wxy wyz w] metric_space_class.dist_triangle[of wxz wyz w]
            wxy(2) wyz(2) wxz(2) by (auto simp add: metric_space_class.dist_commute)

    text ‹We show that $d(x, wxy)$ is close to the Gromov product of $y$ and $z$ seen from $x$.
    This follows from the fact that $w$ is essentially on all geodesics, so that everything simplifies
    when one writes down the Gromov products, leaving only $d(x, w)$ up to $O(\delta)$.
    To get the right $O(\delta)$, one has to be a little bit careful, using the triangular inequality
    when possible. This means that the computations for the upper and lower bounds are different,
    making them a little bit tedious, although straightforward.›
    have "dist y wxy -4 * delta + dist wxy z  dist y wxy - dist wxy wyz + dist wxy z - dist wxy wyz"
      using I by simp
    also have "...  dist wyz y + dist wyz z"
      using metric_space_class.dist_triangle[of y wxy wyz] metric_space_class.dist_triangle[of wxy z wyz]
      by (auto simp add: metric_space_class.dist_commute)
    also have "... = dist y z"
      using wyz(1) by (metis geodesic_segment_dist local.some_geodesic_is_geodesic_segment(1) metric_space_class.dist_commute)
    finally have *: "dist y wxy + dist wxy z - 4 * delta  dist y z" by simp
    have "2 * Gromov_product_at x y z = dist x y + dist x z - dist y z"
      unfolding Gromov_product_at_def by simp
    also have "...  dist x wxy + dist wxy y + dist x wxy + dist wxy z - (dist y wxy + dist wxy z - 4 * delta)"
      using metric_space_class.dist_triangle[of x y wxy] metric_space_class.dist_triangle[of x z wxy] *
      by (auto simp add: metric_space_class.dist_commute)
    also have "... = 2 * dist x wxy + 4 * delta"
      by (auto simp add: metric_space_class.dist_commute)
    finally have A: "Gromov_product_at x y z  dist x wxy + 2 * delta" by simp

    have "dist x wxy -4 * delta + dist wxy z  dist x wxy - dist wxy wxz + dist wxy z - dist wxy wxz"
      using I by simp
    also have "...  dist wxz x + dist wxz z"
      using metric_space_class.dist_triangle[of x wxy wxz] metric_space_class.dist_triangle[of wxy z wxz]
      by (auto simp add: metric_space_class.dist_commute)
    also have "... = dist x z"
      using wxz(1) H(2) by (metis geodesic_segment_dist metric_space_class.dist_commute)
    finally have *: "dist x wxy + dist wxy z - 4 * delta  dist x z" by simp
    have "2 * dist x wxy - 4 * delta = (dist x wxy + dist wxy y) + (dist x wxy + dist wxy z - 4 * delta) - (dist y wxy + dist wxy z)"
      by (auto simp add: metric_space_class.dist_commute)
    also have "...  dist x y + dist x z - dist y z"
      using * metric_space_class.dist_triangle[of y z wxy] geodesic_segment_dist[OF H(1) wxy(1)] by auto
    also have "... = 2 * Gromov_product_at x y z"
      unfolding Gromov_product_at_def by simp
    finally have B: "Gromov_product_at x y z  dist x wxy - 2 * delta" by simp

    define dy where "dy = dist x wxy"
    have *: "wxy = geodesic_segment_param Gxy x dy"
      unfolding dy_def using wxy  Gxy H(1) by auto
    have "dist wxy (geodesic_segment_param Gxy x (Gromov_product_at x y z)) = abs(dy - Gromov_product_at x y z)"
      unfolding * apply (rule geodesic_segment_param(7)[OF H(1)])
      unfolding dy_def using that geodesic_segment_dist_le[OF H(1) wxy(1), of x] by (auto simp add: metric_space_class.dist_commute)
    also have "...  2 * delta"
      using A B unfolding dy_def by auto
    finally have Iy: "dist wxy (geodesic_segment_param Gxy x (Gromov_product_at x y z))  2 * delta"
      by simp

    text ‹We need the same estimate for $wxz$. The proof is exactly the same, copied and pasted.
    It would be better to have a separate statement, but since its assumptions would be rather
    cumbersome I decided to keep the two proofs.›
    have "dist z wxz -4 * delta + dist wxz y  dist z wxz - dist wxz wyz + dist wxz y - dist wxz wyz"
      using I by simp
    also have "...  dist wyz z + dist wyz y"
      using metric_space_class.dist_triangle[of z wxz wyz] metric_space_class.dist_triangle[of wxz y wyz]
      by (auto simp add: metric_space_class.dist_commute)
    also have "... = dist z y"
      using ‹dist wyz y + dist wyz z = dist y z by (auto simp add: metric_space_class.dist_commute)
    finally have *: "dist z wxz + dist wxz y - 4 * delta  dist z y" by simp
    have "2 * Gromov_product_at x y z = dist x z + dist x y - dist z y"
      unfolding Gromov_product_at_def by (simp add: metric_space_class.dist_commute)
    also have "...  dist x wxz + dist wxz z + dist x wxz + dist wxz y - (dist z wxz + dist wxz y - 4 * delta)"
      using metric_space_class.dist_triangle[of x z wxz] metric_space_class.dist_triangle[of x y wxz] *
      by (auto simp add: metric_space_class.dist_commute)
    also have "... = 2 * dist x wxz + 4 * delta"
      by (auto simp add: metric_space_class.dist_commute)
    finally have A: "Gromov_product_at x y z  dist x wxz + 2 * delta" by simp

    have "dist x wxz -4 * delta + dist wxz y  dist x wxz - dist wxz wxy + dist wxz y - dist wxz wxy"
      using I by (simp add: metric_space_class.dist_commute)
    also have "...  dist wxy x + dist wxy y"
      using metric_space_class.dist_triangle[of x wxz wxy] metric_space_class.dist_triangle[of wxz y wxy]
      by (auto simp add: metric_space_class.dist_commute)
    also have "... = dist x y"
      using wxy(1) H(1) by (metis geodesic_segment_dist metric_space_class.dist_commute)
    finally have *: "dist x wxz + dist wxz y - 4 * delta  dist x y" by simp
    have "2 * dist x wxz - 4 * delta = (dist x wxz + dist wxz z) + (dist x wxz + dist wxz y - 4 * delta) - (dist z wxz + dist wxz y)"
      by (auto simp add: metric_space_class.dist_commute)
    also have "...  dist x z + dist x y - dist z y"
      using * metric_space_class.dist_triangle[of z y wxz] geodesic_segment_dist[OF H(2) wxz(1)] by auto
    also have "... = 2 * Gromov_product_at x y z"
      unfolding Gromov_product_at_def by (simp add: metric_space_class.dist_commute)
    finally have B: "Gromov_product_at x y z  dist x wxz - 2 * delta" by simp

    define dz where "dz = dist x wxz"
    have *: "wxz = geodesic_segment_param Gxz x dz"
      unfolding dz_def using wxz  Gxz H(2) by auto
    have "dist wxz (geodesic_segment_param Gxz x (Gromov_product_at x y z)) = abs(dz - Gromov_product_at x y z)"
      unfolding * apply (rule geodesic_segment_param(7)[OF H(2)])
      unfolding dz_def using that geodesic_segment_dist_le[OF H(2) wxz(1), of x] by (auto simp add: metric_space_class.dist_commute)
    also have "...  2 * delta"
      using A B unfolding dz_def by auto
    finally have Iz: "dist wxz (geodesic_segment_param Gxz x (Gromov_product_at x y z))  2 * delta"
      by simp

    have "dist (geodesic_segment_param Gxy x (Gromov_product_at x y z)) (geodesic_segment_param Gxz x (Gromov_product_at x y z))
       dist (geodesic_segment_param Gxy x (Gromov_product_at x y z)) wxy + dist wxy wxz + dist wxz (geodesic_segment_param Gxz x (Gromov_product_at x y z))"
      by (rule dist_triangle4)
    also have "...  2 * delta + 2 * delta + 2 * delta"
      using Iy Iz I by (auto simp add: metric_space_class.dist_commute)
    finally show ?thesis by simp
  qed

  text ‹Second step: the result is true for $t \leq (y,z)_x$, by a continuity argument and a
  reduction to the first step.›
  have "dist (geodesic_segment_param Gxy x t) (geodesic_segment_param Gxz x t)  6 * delta"
    if H: "geodesic_segment_between Gxy x y" "geodesic_segment_between Gxz x z" "t  {0..Gromov_product_at x y z}"
    for x y z t Gxy Gxz
  proof -
    define ys where "ys = (λs. geodesic_segment_param Gxy x (s * dist x y))"
    define zs where "zs = (λs. geodesic_segment_param Gxz x (s * dist x z))"
    define F where "F = (λs. Gromov_product_at x (ys s) (zs s))"
    have "s. 0  s  s  1  F s = t"
    proof (rule IVT')
      show "F 0  t" "t  F 1"
        unfolding F_def using that unfolding ys_def zs_def by (auto simp add: Gromov_product_e_x_x)
      show "continuous_on {0..1} F"
        unfolding F_def Gromov_product_at_def ys_def zs_def
        apply (intro continuous_intros continuous_on_compose2[of "{0..dist x y}" _ _ "λt. t * dist x y"] continuous_on_compose2[of "{0..dist x z}" _ _ "λt. t * dist x z"])
        apply (auto intro!: isometry_on_continuous geodesic_segment_param(4) that)
        using metric_space_class.zero_le_dist mult_left_le_one_le by blast+
    qed (simp)
    then obtain s where s: "s  {0..1}" "t = Gromov_product_at x (ys s) (zs s)"
      unfolding F_def by auto

    have a: "x = geodesic_segment_param Gxy x 0" using H(1) by auto
    have b: "x = geodesic_segment_param Gxz x 0" using H(2) by auto
    have dy: "dist x (ys s) = s * dist x y"
      unfolding ys_def apply (rule geodesic_segment_param[OF H(1)]) using s(1) by (auto simp add: mult_left_le_one_le)
    have dz: "dist x (zs s) = s * dist x z"
      unfolding zs_def apply (rule geodesic_segment_param[OF H(2)]) using s(1) by (auto simp add: mult_left_le_one_le)

    define Gxy2 where "Gxy2 = geodesic_subsegment Gxy x 0 (s * dist x y)"
    define Gxz2 where "Gxz2 = geodesic_subsegment Gxz x 0 (s * dist x z)"

    have "dist (geodesic_segment_param Gxy2 x t) (geodesic_segment_param Gxz2 x t)  6 * delta"
    unfolding s(2) proof (rule Main)
      show "geodesic_segment_between Gxy2 x (ys s)"
        apply (subst a) unfolding Gxy2_def ys_def apply (rule geodesic_subsegment[OF H(1)])
        using s(1) by (auto simp add: mult_left_le_one_le)
      show "geodesic_segment_between Gxz2 x (zs s)"
        apply (subst b) unfolding Gxz2_def zs_def apply (rule geodesic_subsegment[OF H(2)])
        using s(1) by (auto simp add: mult_left_le_one_le)
    qed
    moreover have "geodesic_segment_param Gxy2 x (t-0) = geodesic_segment_param Gxy x t"
      apply (subst a) unfolding Gxy2_def apply (rule geodesic_subsegment(3)[OF H(1)])
      using s(1) H(3) unfolding s(2) apply (auto simp add: mult_left_le_one_le)
      unfolding dy[symmetric] by (rule Gromov_product_le_dist)
    moreover have "geodesic_segment_param Gxz2 x (t-0) = geodesic_segment_param Gxz x t"
      apply (subst b) unfolding Gxz2_def apply (rule geodesic_subsegment(3)[OF H(2)])
      using s(1) H(3) unfolding s(2) apply (auto simp add: mult_left_le_one_le)
      unfolding dz[symmetric] by (rule Gromov_product_le_dist)
    ultimately show ?thesis by simp
  qed
  with controlled_thin_triangles_implies_hyperbolic[OF this]
  show ?thesis by auto
qed



section ‹Metric trees›

text ‹Metric trees have several equivalent definitions. The simplest one is probably that it
is a geodesic space in which the union of two geodesic segments intersecting only at one endpoint is
still a geodesic segment.

Metric trees are Gromov hyperbolic, with $\delta = 0$.›

class metric_tree = geodesic_space +
  assumes geod_union: "geodesic_segment_between G x y  geodesic_segment_between H y z  G  H = {y}  geodesic_segment_between (G  H) x z"

text ‹We will now show that the real line is a metric tree, by identifying its geodesic
segments, i.e., the compact intervals.›

lemma geodesic_segment_between_real:
  assumes "x  (y::real)"
  shows "geodesic_segment_between (G::real set) x y = (G = {x..y})"
proof
  assume H: "geodesic_segment_between G x y"
  then have "connected G" "x  G" "y  G"
    using geodesic_segment_topology(2) geodesic_segmentI geodesic_segment_endpoints by auto
  then have *: "{x..y}  G"
    by (simp add: connected_contains_Icc)
  moreover have "G  {x..y}"
  proof
    fix s assume "s  G"
    have "abs(s-x) + abs(s-y) = abs(x-y)"
      using geodesic_segment_dist[OF H s  G] unfolding dist_real_def by auto
    then show "s  {x..y}" using x  y by auto
  qed
  ultimately show "G = {x..y}" by auto
next
  assume H: "G = {x..y}"
  define g where "g = (λt. t + x)"
  have "g 0 = x  g (dist x y) = y  isometry_on {0..dist x y} g  G = g ` {0..dist x y}"
    unfolding g_def isometry_on_def H using x  y by (auto simp add: dist_real_def)
  then have "g. g 0 = x  g (dist x y) = y  isometry_on {0..dist x y} g  G = g ` {0..dist x y}"
    by auto
  then show "geodesic_segment_between G x y" unfolding geodesic_segment_between_def by auto
qed

lemma geodesic_segment_between_real':
  "{x--y} = {min x y..max x (y::real)}"
by (metis geodesic_segment_between_real geodesic_segment_commute some_geodesic_is_geodesic_segment(1) max_def min.cobounded1 min_def)

lemma geodesic_segment_real:
  "geodesic_segment (G::real set) = (x y. x  y  G = {x..y})"
proof
  assume "geodesic_segment G"
  then obtain x y where *: "geodesic_segment_between G x y" unfolding geodesic_segment_def by auto
  have "(x  y  G = {x..y})  (y  x  G = {y..x})"
    apply (rule le_cases[of x y])
    using geodesic_segment_between_real * geodesic_segment_commute apply simp
    using geodesic_segment_between_real * geodesic_segment_commute by metis
  then show "x y. x  y  G = {x..y}" by auto
next
  assume "x y. x  y  G = {x..y}"
  then show "geodesic_segment G"
    unfolding geodesic_segment_def using geodesic_segment_between_real by metis
qed

instance real::metric_tree
proof
  fix G H::"real set" and x y z::real assume GH: "geodesic_segment_between G x y" "geodesic_segment_between H y z" "G  H = {y}"
  have G: "G = {min x y..max x y}" using GH
    by (metis geodesic_segment_between_real geodesic_segment_commute inf_real_def inf_sup_ord(2) max.coboundedI2 max_def min_def)
  have H: "H = {min y z..max y z}" using GH
    by (metis geodesic_segment_between_real geodesic_segment_commute inf_real_def inf_sup_ord(2) max.coboundedI2 max_def min_def)
  have *: "(x  y  y  z)  (z  y  y  x)"
    using G H G  H = {y} unfolding min_def max_def
    apply auto
    apply (metis (mono_tags, hide_lams) min_le_iff_disj order_refl)
    by (metis (full_types) less_eq_real_def max_def)
  show "geodesic_segment_between (G  H) x z"
    using * apply rule
    using G  H = {y} unfolding G H apply (metis G GH(1) GH(2) H geodesic_segment_between_real ivl_disj_un_two_touch(4) order_trans)
    using G  H = {y} unfolding G H
    by (metis (full_types) Un_commute geodesic_segment_between_real geodesic_segment_commute ivl_disj_un_two_touch(4) le_max_iff_disj max.absorb_iff2 max.commute min_absorb2)
qed

context metric_tree begin

text ‹We show that a metric tree is uniquely geodesic.›

subclass uniquely_geodesic_space
proof
  fix x y G H assume H: "geodesic_segment_between G x y" "geodesic_segment_between H x (y::'a)"
  show "G = H"
  proof (rule uniquely_geodesic_spaceI[OF _ H])
    fix G H x y assume "geodesic_segment_between G x y" "geodesic_segment_between H x y" "G  H = {x, (y::'a)}"
    show "x = y"
    proof (rule ccontr)
      assume "x  y"
      then have "dist x y > 0" by auto
      obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "G = g`{0..dist x y}"
        by (meson ‹geodesic_segment_between G x y geodesic_segment_between_def)
      define G2 where "G2 = g`{0..dist x y/2}"
      have "G2  G" unfolding G2_def g(4) by auto
      define z where "z = g(dist x y/2)"
      have "dist x z = dist x y/2"
        using isometry_onD[OF g(3), of 0 "dist x y/2"] g(1) z_def unfolding dist_real_def by auto
      have "dist y z = dist x y/2"
        using isometry_onD[OF g(3), of "dist x y" "dist x y/2"] g(2) z_def unfolding dist_real_def by auto

      have G2: "geodesic_segment_between G2 x z" unfolding g 0 = x[symmetric] z_def G2_def
        apply (rule geodesic_segmentI2) by (rule isometry_on_subset[OF g(3)], auto simp add: g 0 = x)
      have [simp]: "x  G2" "z  G2" using geodesic_segment_endpoints G2 by auto
      have "dist x a  dist x z" if "a  G2" for a
        apply (rule geodesic_segment_dist_le) using G2 that by auto
      also have "... < dist x y" unfolding ‹dist x z = dist x y/2 using ‹dist x y > 0 by auto
      finally have "y  G2" by auto

      then have "G2  H = {x}"
        using G2  G x  G2 G  H = {x, y} by auto
      have *: "geodesic_segment_between (G2  H) z y"
        apply (rule geod_union[of _ _ x])
        using G2  H = {x} ‹geodesic_segment_between H x y G2 by (auto simp add: geodesic_segment_commute)
      have "dist x y  dist z x + dist x y" by auto
      also have "... = dist z y"
        apply (rule geodesic_segment_dist[OF *]) using G  H = {x, y} by auto
      also have "... = dist x y / 2"
        by (simp add: ‹dist y z = dist x y / 2 metric_space_class.dist_commute)
      finally show False using ‹dist x y > 0 by auto
    qed
  qed
qed

text ‹An important property of metric trees is that any geodesic triangle is degenerate, i.e., the
three sides intersect at a unique point, the center of the triangle, that we introduce now.›

definition center::"'a  'a  'a  'a"
  where "center x y z = (SOME t. t  {x--y}  {x--z}  {y--z})"

lemma center_as_intersection:
  "{x--y}  {x--z}  {y--z} = {center x y z}"
proof -
  obtain g where g: "g 0 = x" "g (dist x y) = y" "isometry_on {0..dist x y} g" "{x--y} = g`{0..dist x y}"
    by (meson geodesic_segment_between_def some_geodesic_is_geodesic_segment(1))
  obtain h where h: "h 0 = x" "h (dist x z) = z" "isometry_on {0..dist x z} h" "{x--z} = h`{0..dist x z}"
    by (meson geodesic_segment_between_def some_geodesic_is_geodesic_segment(1))

  define Z where "Z = {t  {0..min (dist x y) (dist x z)}. g t = h t}"
  have "0  Z" unfolding Z_def using g(1) h(1) by auto
  have [simp]: "closed Z"
  proof -
    have *: "Z = (λs. dist (g s) (h s))-`{0}  {0..min (dist x y) (dist x z)}"
      unfolding Z_def by auto
    show ?thesis
      unfolding * apply (rule closed_vimage_Int)
      using continuous_on_subset[OF isometry_on_continuous[OF g(3)], of "{0..min (dist x y) (dist x z)}"]
            continuous_on_subset[OF isometry_on_continuous[OF h(3)], of "{0..min (dist x y) (dist x z)}"]
            continuous_on_dist by auto
  qed
  define a where "a = Sup Z"
  have "a  Z"
    unfolding a_def apply (rule closed_contains_Sup, auto) using 0  Z Z_def by auto
  define c where "c = h a"
  then have a: "g a = c" "h a = c" "a  0" "a  dist x y" "a  dist x z"
    using a  Z unfolding Z_def c_def by auto

  define G2 where "G2 = g`{a..dist x y}"
  have G2: "geodesic_segment_between G2 (g a) (g (dist x y))"
    unfolding G2_def apply (rule geodesic_segmentI2)
    using isometry_on_subset[OF g(3)] a  Z unfolding Z_def by auto
  define H2 where "H2 = h`{a..dist x z}"
  have H2: "geodesic_segment_between H2 (h a) (h (dist x z))"
    unfolding H2_def apply (rule geodesic_segmentI2)
    using isometry_on_subset[OF h(3)] a  Z unfolding Z_def by auto
  have "G2  H2  {c}"
  proof
    fix w assume w: "w  G2  H2"
    obtain sg where sg: "w = g sg" "sg  {a..dist x y}" using w unfolding G2_def by auto
    obtain sh where sh: "w = h sh" "sh  {a..dist x z}" using w unfolding H2_def by auto
    have "dist w x = sg"
      unfolding g(1)[symmetric] sg(1) using isometry_onD[OF g(3), of 0 sg] sg(2)
      unfolding dist_real_def using a by (auto simp add: metric_space_class.dist_commute)
    moreover have "dist w x = sh"
      unfolding h(1)[symmetric] sh(1) using isometry_onD[OF h(3), of 0 sh] sh(2)
      unfolding dist_real_def using a by (auto simp add: metric_space_class.dist_commute)
    ultimately have "sg = sh" by simp
    have "sh  Z" unfolding Z_def using sg sh a  0 unfolding sg = sh by auto
    then have "sh  a"
      unfolding a_def apply (rule cSup_upper) unfolding Z_def by auto
    then have "sh = a" using sh(2) by auto
    then show "w  {c}" unfolding sh(1) using a(2) by auto
  qed
  then have *: "G2  H2 = {c}"
    unfolding G2_def H2_def using a by (auto simp add: image_iff, force)
  have "geodesic_segment_between (G2  H2) y z"
    apply (subst g(2)[symmetric], subst h(2)[symmetric]) apply(rule geod_union[of _ _ "h a"])
    using geodesic_segment_commute G2 H2 a * by force+
  then have "G2  H2 = {y--z}"
    using geodesic_segment_unique by auto
  then have "c  {y--z}" using * by auto
  then have *: "c  {x--y}  {x--z}  {y--z}"
    using g(4) h(4) c_def a by force
  have center: "center x y z  {x--y}  {x--z}  {y--z}"
    unfolding center_def using someI[of "λp. p  {x--y}  {x--z}  {y--z}", OF *] by blast
  have *: "dist x d = Gromov_product_at x y z" if "d  {x--y}  {x--z}  {y--z}" for d
  proof -
    have "dist x y = dist x d + dist d y"
         "dist x z = dist x d + dist d z"
         "dist y z = dist y d + dist d z"
      using that by (auto simp add: geodesic_segment_dist geodesic_segment_unique)
    then show ?thesis unfolding Gromov_product_at_def by (auto simp add: metric_space_class.dist_commute)
  qed
  have "d = center x y z" if "d  {x--y}  {x--z}  {y--z}" for d
    apply (rule geodesic_segment_dist_unique[of "{x--y}" x y])
    using *[OF that] *[OF center] that center by auto
  then show "{x--y}  {x--z}  {y--z} = {center x y z}" using center by blast
qed

lemma center_on_geodesic [simp]:
  "center x y z  {x--y}"
  "center x y z  {x--z}"
  "center x y z  {y--z}"
  "center x y z  {y--x}"
  "center x y z  {z--x}"
  "center x y z  {z--y}"
using center_as_intersection by (auto simp add: some_geodesic_commute)

lemma center_commute:
  "center x y z = center x z y"
  "center x y z = center y x z"
  "center x y z = center y z x"
  "center x y z = center z x y"
  "center x y z = center z y x"
using center_as_intersection some_geodesic_commute by blast+

lemma center_dist:
  "dist x (center x y z) = Gromov_product_at x y z"
proof -
  have "dist x y = dist x (center x y z) + dist (center x y z) y"
       "dist x z = dist x (center x y z) + dist (center x y z) z"
       "dist y z = dist y (center x y z) + dist (center x y z) z"
    by (auto simp add: geodesic_segment_dist geodesic_segment_unique)
  then show ?thesis unfolding Gromov_product_at_def by (auto simp add: metric_space_class.dist_commute)
qed

lemma geodesic_intersection:
  "{x--y}  {x--z} = {x--center x y z}"
proof -
  have "{x--y} = {x--center x y z}  {center x y z--y}"
    using center_as_intersection geodesic_segment_split by blast
  moreover have "{x--z} = {x--center x y z}  {center x y z--z}"
    using center_as_intersection geodesic_segment_split by blast
  ultimately have "{x--y}  {x--z} = {x--center x y z}  ({center x y z--y}  {x--center x y z})  ({center x y z--y}  {x--center x y z})  ({center x y z--y}  {center x y z--z})"
    by auto
  moreover have "{center x y z--y}  {x--center x y z} = {center x y z}"
    using geodesic_segment_split(2) center_as_intersection[of x y z] by auto
  moreover have "{center x y z--y}  {x--center x y z} = {center x y z}"
    using geodesic_segment_split(2) center_as_intersection[of x y z] by auto
  moreover have "{center x y z--y}  {center x y z--z} = {center x y z}"
    using geodesic_segment_split(2)[of "center x y z" y z] center_as_intersection[of x y z] by (auto simp add: some_geodesic_commute)
  ultimately show "{x--y}  {x--z} = {x--center x y z}" by auto
qed
end (*of context metric_tree*)

text ‹We can now prove that a metric tree is Gromov hyperbolic, for $\delta = 0$. The simplest
proof goes through the slim triangles property: it suffices to show that, given a geodesic triangle,
there is a point at distance at most $0$ of each of its sides. This is the center we have
constructed above.›

class metric_tree_with_delta = metric_tree + metric_space_with_deltaG +
  assumes delta0: "deltaG(TYPE('a::metric_space)) = 0"

class Gromov_hyperbolic_space_0 = Gromov_hyperbolic_space +
  assumes delta0 [simp]: "deltaG(TYPE('a::metric_space)) = 0"

class Gromov_hyperbolic_space_0_geodesic = Gromov_hyperbolic_space_0 + geodesic_space

text ‹Isabelle does not accept cycles in the class graph. So, we will show that
\verb+metric_tree_with_delta+ is a subclass of \verb+Gromov_hyperbolic_space_0_geodesic+, and
conversely that \verb+Gromov_hyperbolic_space_0_geodesic+ is a subclass of \verb+metric_tree+.

In a tree, we have already proved that triangles are $0$-slim (the center is common to all sides
of the triangle). The $0$-hyperbolicity follows from one of the equivalent characterizations
of hyperbolicity (the other characterizations could be used as well, but the proofs would be
less immediate.)›

subclass (in metric_tree_with_delta) Gromov_hyperbolic_space_0
proof (standard)
  show "deltaG TYPE('a) = 0" unfolding delta0 by auto
  have "Gromov_hyperbolic_subset (6 * 0) (UNIV::'a set)"
  proof (rule slim_triangles_implies_hyperbolic)
    fix x::'a and y z Gxy Gyz Gxz
    define w where "w = center x y z"
    assume "geodesic_segment_between Gxy x y"
        "geodesic_segment_between Gxz x z" "geodesic_segment_between Gyz y z"
    then have "Gxy = {x--y}" "Gyz = {y--z}" "Gxz = {x--z}"
      by (auto simp add: local.geodesic_segment_unique)
    then have "w  Gxy" "w  Gyz" "w  Gxz"
      unfolding w_def by auto
    then have "infdist w Gxy  0  infdist w Gxz  0  infdist w Gyz  0"
      by auto
    then show "w. infdist w Gxy  0  infdist w Gxz  0  infdist w Gyz  0"
      by blast
  qed
  then show "Gromov_hyperbolic_subset (deltaG TYPE('a)) (UNIV::'a set)" unfolding delta0 by auto
qed

text ‹To use the fact that reals are Gromov hyperbolic, given that they are a metric tree,
we need to instantiate them as \verb+metric_tree_with_delta+.›

instantiation real::metric_tree_with_delta
begin
definition deltaG_real::"real itself  real"
  where "deltaG_real _ = 0"
instance apply standard unfolding deltaG_real_def by auto
end

text ‹Let us now prove the converse: a geodesic space which is $\delta$-hyperbolic for $\delta = 0$
is a metric tree. For the proof, we consider two geodesic segments $G = [x,y]$ and $H = [y,z]$ with a common
endpoint, and we have to show that their union is still a geodesic segment from $x$ to $z$. For
this, introduce a geodesic segment $L = [x,z]$. By the property of thin triangles, $G$ is included
in $H \cup L$. In particular, a point $Y$ close to $y$ but different from $y$ on $G$ is on $L$,
and therefore realizes the equality $d(x,z) = d(x, Y) + d(Y, z)$. Passing to the limit, $y$
also satisfies this equality. The conclusion readily follows thanks to Lemma
\verb+geodesic_segment_union+.
›

subclass (in Gromov_hyperbolic_space_0_geodesic) metric_tree
proof
  fix G H x y z assume A: "geodesic_segment_between G x y" "geodesic_segment_between H y z" "G  H = {y::'a}"
  show "geodesic_segment_between (G  H) x z"
  proof (cases "x = y")
    case True
    then show ?thesis
      by (metis A Un_commute geodesic_segment_between_x_x(3) inf.commute sup_inf_absorb)
  next
    case False
    define D::"nat  real" where "D = (λn. dist x y - (dist x y) * (1/(real(n+1))))"
    have D: "D n  {0..< dist x y}" "D n  {0..dist x y}" for n
      unfolding D_def by (auto simp add: False divide_simps algebra_simps)
    have Dlim: "D  dist x y - dist x y * 0"
      unfolding D_def by (intro tendsto_intros LIMSEQ_ignore_initial_segment[OF lim_1_over_n, of 1])

    define Y::"nat  'a" where "Y = (λn. geodesic_segment_param G x (D n))"
    have *: "Y  y"
      unfolding Y_def apply (subst geodesic_segment_param(2)[OF A(1), symmetric])
      using isometry_on_continuous[OF geodesic_segment_param(4)[OF A(1)]]
      unfolding continuous_on_sequentially comp_def using D(2) Dlim by auto

    have "dist x z = dist x (Y n) + dist (Y n) z" for n
    proof -
      obtain L where L: "geodesic_segment_between L x z" using geodesic_subsetD[OF geodesic] by blast
      have "Y n  G" unfolding Y_def
        apply (rule geodesic_segment_param(3)[OF A(1)]) using D[of n] by auto
      have "dist x (Y n) = D n"
        unfolding Y_def apply (rule geodesic_segment_param[OF A(1)]) using D[of n] by auto
      then have "Y n  y"
        using D[of n] by auto
      then have "Y n  H" using A(3) Y n  G by auto
      have "infdist (Y n) (H  L)  4 * deltaG(TYPE('a))"
        apply (rule thin_triangles[OF geodesic_segment_commute[OF A(2)] geodesic_segment_commute[OF L] geodesic_segment_commute[OF A(1)]])
        using Y n  G by simp
      then have "infdist (Y n) (H  L) = 0"
        using infdist_nonneg[of "Y n" "H  L"] unfolding delta0 by auto
      have "Y n  H  L"
      proof (subst in_closed_iff_infdist_zero)
        have "closed H"
          using A(2) geodesic_segment_topology geodesic_segment_def by fastforce
        moreover have "closed L"
          using L geodesic_segment_topology geodesic_segment_def by fastforce
        ultimately show "closed (H  L)" by auto
        show "H  L  {}" using A(2) geodesic_segment_endpoints(1) by auto
      qed (fact)
      then have "Y n  L" using Y n  H by simp
      show ?thesis using geodesic_segment_dist[OF L Y n  L] by simp
    qed
    moreover have "(λn. dist x (Y n) + dist (Y n) z)  dist x y + dist y z"
      by (intro tendsto_intros *)
    ultimately have "(λn. dist x z)  dist x y + dist y z"
      using filterlim_cong eventually_sequentially by auto
    then have *: "dist x z = dist x y + dist y z"
      using LIMSEQ_unique by auto
    show "geodesic_segment_between (G  H) x z"
      by (rule geodesic_segment_union[OF * A(1) A(2)])
  qed
qed

end (*of theory Gromov_Hyperbolic*)

Theory Morse_Gromov_Theorem

(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
    License: BSD
*)


theory Morse_Gromov_Theorem
  imports "HOL-Decision_Procs.Approximation" Gromov_Hyperbolicity Hausdorff_Distance
begin

hide_const (open) Approximation.Min
hide_const (open) Approximation.Max

section ‹Quasiconvexity›

text ‹In a Gromov-hyperbolic setting, convexity is not a well-defined notion as everything should
be coarse. The good replacement is quasi-convexity: A set $X$ is $C$-quasi-convex if any pair of
points in $X$ can be joined by a geodesic that remains within distance $C$ of $X$. One could also
require this for all geodesics, up to changing $C$, as two geodesics between the same endpoints
remain within uniformly bounded distance. We use the first definition to ensure that a geodesic is
$0$-quasi-convex.›

definition quasiconvex::"real  ('a::metric_space) set  bool"
  where "quasiconvex C X = (C  0  (xX. yX. G. geodesic_segment_between G x y  (zG. infdist z X  C)))"

lemma quasiconvexD:
  assumes "quasiconvex C X" "x  X" "y  X"
  shows "G. geodesic_segment_between G x y  (zG. infdist z X  C)"
using assms unfolding quasiconvex_def by auto

lemma quasiconvexC:
  assumes "quasiconvex C X"
  shows "C  0"
using assms unfolding quasiconvex_def by auto

lemma quasiconvexI:
  assumes "C  0"
          "x y. x  X  y  X  (G. geodesic_segment_between G x y  (zG. infdist z X  C))"
  shows "quasiconvex C X"
using assms unfolding quasiconvex_def by auto

lemma quasiconvex_of_geodesic:
  assumes "geodesic_segment G"
  shows "quasiconvex 0 G"
proof (rule quasiconvexI, simp)
  fix x y assume *: "x  G" "y  G"
  obtain H where H: "H  G" "geodesic_segment_between H x y"
    using geodesic_subsegment_exists[OF assms(1) *] by auto
  have "infdist z G  0" if "z  H" for z
    using H(1) that by auto
  then show "H. geodesic_segment_between H x y  (zH. infdist z G  0)"
    using H(2) by auto
qed

lemma quasiconvex_empty:
  assumes "C  0"
  shows "quasiconvex C {}"
unfolding quasiconvex_def using assms by auto

lemma quasiconvex_mono:
  assumes "C  D"
          "quasiconvex C G"
  shows "quasiconvex D G"
using assms unfolding quasiconvex_def by (auto, fastforce)

text ‹The $r$-neighborhood of a quasi-convex set is still quasi-convex in a hyperbolic space,
for a constant that does not depend on $r$.›

lemma (in Gromov_hyperbolic_space_geodesic) quasiconvex_thickening:
  assumes "quasiconvex C (X::'a set)" "r  0"
  shows "quasiconvex (C + 8 *deltaG(TYPE('a))) (xX. cball x r)"
proof (rule quasiconvexI)
  show "C + 8 *deltaG(TYPE('a))  0" using quasiconvexC[OF assms(1)] by simp
next
  fix y z assume *: "y  (xX. cball x r)" "z  (xX. cball x r)"
  have A: "infdist w (xX. cball x r)  C + 8 * deltaG TYPE('a)" if "w  {y--z}" for w
  proof -
    obtain py where py: "py  X" "y  cball py r"
      using * by auto
    obtain pz where pz: "pz  X" "z  cball pz r"
      using * by auto
    obtain G where G: "geodesic_segment_between G py pz" "(pG. infdist p X  C)"
      using quasiconvexD[OF assms(1) py  X pz  X] by auto
    have A: "infdist w ({y--py}  G  {pz--z})  8 * deltaG(TYPE('a))"
      by (rule thin_quadrilaterals[OF _ G(1) _ _ w  {y--z}, where ?x = y and ?t = z], auto)
    have "u  {y--py}  G  {pz--z}. infdist w ({y--py}  G  {pz--z}) = dist w u"
      apply (rule infdist_proper_attained, auto intro!: proper_Un simp add: geodesic_segment_topology(7))
      by (meson G(1) geodesic_segmentI geodesic_segment_topology(7))
    then obtain u where u: "u  {y--py}  G  {pz--z}" "infdist w ({y--py}  G  {pz--z}) = dist w u"
      by auto
    then consider "u  {y--py}" | "u  G" | "u  {pz--z}" by auto
    then have "infdist u (xX. cball x r)  C"
    proof (cases)
      case 1
      then have "dist py u  dist py y"
        using geodesic_segment_dist_le local.some_geodesic_is_geodesic_segment(1) some_geodesic_commute some_geodesic_endpoints(1) by blast
      also have "...  r"
        using py(2) by auto
      finally have "u  cball py r"
        by auto
      then have "u  (xX. cball x r)"
        using py(1) by auto
      then have "infdist u (xX. cball x r) = 0"
        by auto
      then show ?thesis
        using quasiconvexC[OF assms(1)] by auto
    next
      case 3
      then have "dist pz u  dist pz z"
        using geodesic_segment_dist_le local.some_geodesic_is_geodesic_segment(1) some_geodesic_commute some_geodesic_endpoints(1) by blast
      also have "...  r"
        using pz(2) by auto
      finally have "u  cball pz r"
        by auto
      then have "u  (xX. cball x r)"
        using pz(1) by auto
      then have "infdist u (xX. cball x r) = 0"
        by auto
      then show ?thesis
        using quasiconvexC[OF assms(1)] by auto
    next
      case 2
      have "infdist u (xX. cball x r)  infdist u X"
        apply (rule infdist_mono) using assms(2) py(1) by auto
      then show ?thesis using 2 G(2) by auto
    qed
    moreover have "infdist w (xX. cball x r)  infdist u (xX. cball x r) + dist w u"
      by (intro mono_intros)
    ultimately show ?thesis
      using A u(2) by auto
  qed
  show "G. geodesic_segment_between G y z  (wG. infdist w (xX. cball x r)  C + 8 * deltaG TYPE('a))"
    apply (rule exI[of _ "{y--z}"]) using A by auto
qed

text ‹If $x$ has a projection $p$ on a quasi-convex set $G$, then all segments from a point in $G$
to $x$ go close to $p$, i.e., the triangular inequality $d(x,y) \leq d(x,p) + d(p,y)$ is essentially
an equality, up to an additive constant.›

lemma (in Gromov_hyperbolic_space_geodesic) dist_along_quasiconvex:
  assumes "quasiconvex C G" "p  proj_set x G" "y  G"
  shows "dist x p + dist p y  dist x y + 4 * deltaG(TYPE('a)) + 2 * C"
proof -
  have *: "p  G"
    using assms proj_setD by auto
  obtain H where H: "geodesic_segment_between H p y" "q. q  H  infdist q G  C"
    using quasiconvexD[OF assms(1) * assms(3)] by auto
  have "mH. infdist x H = dist x m"
    apply (rule infdist_proper_attained[of H x]) using geodesic_segment_topology[OF geodesic_segmentI[OF H(1)]] by auto
  then obtain m where m: "m  H" "infdist x H = dist x m" by auto
  then have I: "dist x m  Gromov_product_at x p y + 2 * deltaG(TYPE('a))"
    using infdist_triangle_side[OF H(1), of x] by auto
  have "dist x p - dist x m - C  e" if "e > 0" for e
  proof -
    have "rG. dist m r < infdist m G + e"
      apply (rule infdist_almost_attained) using e > 0 assms(3) by auto
    then obtain r where r: "r  G" "dist m r < infdist m G + e"
      by auto
    then have *: "dist m r  C + e" using H(2)[OF m  H] by auto
    have "dist x p  dist x r"
      using r  G assms(2) proj_set_dist_le by blast
    also have "...  dist x m + dist m r"
      by (intro mono_intros)
    finally show ?thesis using * by (auto simp add: metric_space_class.dist_commute)
  qed
  then have "dist x p - dist x m - C  0"
    using dense_ge by blast
  then show ?thesis
    using I unfolding Gromov_product_at_def by (auto simp add: algebra_simps divide_simps)
qed

text ‹The next lemma is~\cite[Proposition 10.2.1]{coornaert_delzant_papadopoulos} with better
constants. It states that the distance between the projections
on a quasi-convex set is controlled by the distance of the original points, with a gain given by the
distances of the points to the set.›

lemma (in Gromov_hyperbolic_space_geodesic) proj_along_quasiconvex_contraction:
  assumes "quasiconvex C G" "px  proj_set x G" "py  proj_set y G"
  shows "dist px py  max (5 * deltaG(TYPE('a)) + 2 * C) (dist x y - dist px x - dist py y + 10 * deltaG(TYPE('a)) + 4 * C)"
proof -
  have "px  G" "py  G"
    using assms proj_setD by auto
  have "(dist x px + dist px py - 4 * deltaG(TYPE('a)) - 2 * C) + (dist y py + dist py px - 4 *deltaG(TYPE('a)) - 2 * C)
         dist x py + dist y px"
    apply (intro mono_intros)
    using dist_along_quasiconvex[OF assms(1) assms(2) py  G] dist_along_quasiconvex[OF assms(1) assms(3) px  G] by auto
  also have "...  max (dist x y + dist py px) (dist x px + dist py y) + 2 * deltaG(TYPE('a))"
    by (rule hyperb_quad_ineq)
  finally have *: "dist x px + dist y py + 2 * dist px py
           max (dist x y + dist py px) (dist x px + dist py y) + 10 * deltaG(TYPE('a)) + 4 * C"
    by (auto simp add: metric_space_class.dist_commute)
  show ?thesis
  proof (cases "dist x y + dist py px  dist x px + dist py y")
    case True
    then have "dist x px + dist y py + 2 * dist px py  dist x y + dist py px + 10 * deltaG(TYPE('a)) + 4 * C"
      using * by auto
    then show ?thesis by (auto simp add: metric_space_class.dist_commute)
  next
    case False
    then have "dist x px + dist y py + 2 * dist px py  dist x px + dist py y + 10 * deltaG(TYPE('a)) + 4 * C"
      using * by auto
    then show ?thesis by (simp add: metric_space_class.dist_commute)
  qed
qed

text ‹The projection on a quasi-convex set is $1$-Lipschitz up to an additive error.›

lemma (in Gromov_hyperbolic_space_geodesic) proj_along_quasiconvex_contraction':
  assumes "quasiconvex C G" "px  proj_set x G" "py  proj_set y G"
  shows "dist px py  dist x y + 4 * deltaG(TYPE('a)) + 2 * C"
proof (cases "dist y py  dist x px")
  case True
  have "dist x px + dist px py  dist x py + 4 * deltaG(TYPE('a)) + 2 * C"
    by (rule dist_along_quasiconvex[OF assms(1) assms(2) proj_setD(1)[OF assms(3)]])
  also have "...  (dist x y + dist y py) + 4 * deltaG(TYPE('a)) + 2 * C"
    by (intro mono_intros)
  finally show ?thesis using True by auto
next
  case False
  have "dist y py + dist py px  dist y px + 4 * deltaG(TYPE('a)) + 2 * C"
    by (rule dist_along_quasiconvex[OF assms(1) assms(3) proj_setD(1)[OF assms(2)]])
  also have "...  (dist y x + dist x px) + 4 * deltaG(TYPE('a)) + 2 * C"
    by (intro mono_intros)
  finally show ?thesis using False by (auto simp add: metric_space_class.dist_commute)
qed

text ‹We can in particular specialize the previous statements to geodesics, which are
$0$-quasi-convex.›

lemma (in Gromov_hyperbolic_space_geodesic) dist_along_geodesic:
  assumes "geodesic_segment G" "p  proj_set x G" "y  G"
  shows "dist x p + dist p y  dist x y + 4 * deltaG(TYPE('a))"
using dist_along_quasiconvex[OF quasiconvex_of_geodesic[OF assms(1)] assms(2) assms(3)] by auto

lemma (in Gromov_hyperbolic_space_geodesic) proj_along_geodesic_contraction:
  assumes "geodesic_segment G" "px  proj_set x G" "py  proj_set y G"
  shows "dist px py  max (5 * deltaG(TYPE('a))) (dist x y - dist px x - dist py y + 10 * deltaG(TYPE('a)))"
using proj_along_quasiconvex_contraction[OF quasiconvex_of_geodesic[OF assms(1)] assms(2) assms(3)] by auto

lemma (in Gromov_hyperbolic_space_geodesic) proj_along_geodesic_contraction':
  assumes "geodesic_segment G" "px  proj_set x G" "py  proj_set y G"
  shows "dist px py  dist x y + 4 * deltaG(TYPE('a))"
using proj_along_quasiconvex_contraction'[OF quasiconvex_of_geodesic[OF assms(1)] assms(2) assms(3)] by auto

text ‹If one projects a continuous curve on a quasi-convex set, the image does not have to be
connected (the projection is discontinuous), but since the projections of nearby points are within
uniformly bounded distance one can find in the projection a point with almost prescribed distance
to the starting point, say. For further applications, we also pick the first such point, i.e.,
all the previous points are also close to the starting point.›

lemma (in Gromov_hyperbolic_space_geodesic) quasi_convex_projection_small_gaps:
  assumes "continuous_on {a..(b::real)} f"
          "a  b"
          "quasiconvex C G"
          "t. t  {a..b}  p t  proj_set (f t) G"
          "delta > deltaG(TYPE('a))"
          "d  {4 * delta + 2 * C..dist (p a) (p b)}"
  shows "t  {a..b}. (dist (p a) (p t)  {d - 4 * delta - 2 * C .. d})
                     (s  {a..t}. dist (p a) (p s)  d)"
proof -
  have "delta > 0"
    using assms(5) local.delta_nonneg by linarith
  moreover have "C  0"
    using quasiconvexC[OF assms(3)] by simp
  ultimately have "d  0" using assms by auto

  text ‹The idea is to define the desired point as the last point $u$ for which there is a projection
  at distance at most $d$ of the starting point. Then the projection can not be much closer to
  the starting point, or one could point another such point further away by almost continuity, giving
  a contradiction. The technical implementation requires some care, as the "last point" may not
  satisfy the property, for lack of continuity. If it does, then fine. Otherwise, one should go just
  a little bit to its left to find the desired point.›
  define I where "I = {t  {a..b}. s  {a..t}. dist (p a) (p s)  d}"
  have "a  I"
    using a  b d  0 unfolding I_def by auto
  have "bdd_above I"
    unfolding I_def by auto
  define u where "u = Sup I"
  have "a  u"
    unfolding u_def apply (rule cSup_upper) using a  I ‹bdd_above I by auto
  have "u  b"
    unfolding u_def apply (rule cSup_least) using a  I apply auto unfolding I_def by auto
  have A: "dist (p a) (p s)  d" if "s < u" "a  s" for s
  proof -
    have "tI. s < t"
      unfolding u_def apply (subst less_cSup_iff[symmetric])
      using a  I ‹bdd_above I using s < u unfolding u_def by auto
    then obtain t where t: "t  I" "s < t" by auto
    then have "s  {a..t}" using a  s by auto
    then show ?thesis
      using t(1) unfolding I_def by auto
  qed
  have "continuous (at u within {a..b}) f"
    using assms(1) by (simp add: a  u u  b continuous_on_eq_continuous_within)
  then have "i > 0. s{a..b}. dist u s < i  dist (f u) (f s) < (delta - deltaG(TYPE('a)))"
    unfolding continuous_within_eps_delta using ‹deltaG(TYPE('a)) < delta by (auto simp add: metric_space_class.dist_commute)
  then obtain e0 where e0: "e0 > 0" "s. s  {a..b}  dist u s < e0  dist (f u) (f s) < (delta - deltaG(TYPE('a)))"
    by auto

  show ?thesis
  proof (cases "dist (p a) (p u) > d")
    text ‹First, consider the case where $u$ does not satisfy the defining property. Then the
    desired point $t$ is taken slightly to its left.›
    case True
    then have "u  a"
      using d  0 by auto
    then have "a < u" using a  u by auto

    define e::real where "e = min (e0/2) ((u-a)/2)"
    then have "e > 0" using a < u e0 > 0 by auto
    define t where "t = u - e"
    then have "t < u" using e > 0 by auto
    have "u - b  e" "e  u - a"
      using e > 0 u  b unfolding e_def by (auto simp add: min_def)
    then have "t  {a..b}" "t  {a..t}"
      unfolding t_def by auto
    have "dist u t < e0"
      unfolding t_def e_def dist_real_def using e0 > 0 a  u by auto
    have *: "s  {a..t}. dist (p a) (p s)  d"
      using A t < u by auto
    have "dist (p t) (p u)  dist (f t) (f u) + 4 * deltaG(TYPE('a)) + 2 * C"
      apply (rule proj_along_quasiconvex_contraction'[OF ‹quasiconvex C G])
      using assms (4) t  {a..b} a  u u  b by auto
    also have "...  (delta - deltaG(TYPE('a))) + 4 * deltaG(TYPE('a)) + 2 * C"
      apply (intro mono_intros)
      using e0(2)[OF t  {a..b} ‹dist u t < e0] by (auto simp add: metric_space_class.dist_commute)
    finally have I: "dist (p t) (p u)  4 * delta + 2 * C"
      using delta > deltaG(TYPE('a)) by simp

    have "d  dist (p a) (p u)"
      using True by auto
    also have "...  dist (p a) (p t) + dist (p t) (p u)"
      by (intro mono_intros)
    also have "...  dist (p a) (p t) + 4 * delta + 2 * C"
      using I by simp
    finally have **: "d - 4 * delta - 2 * C  dist (p a) (p t)"
      by simp
    show ?thesis
      apply (rule bexI[OF _ t  {a..b}]) using * ** t  {a..b} by auto
  next
    text ‹Next, consider the case where $u$ satisfies the defining property. Then we will take $t = u$.
    The only nontrivial point to check is that the distance of $f(u)$ to the starting point is not
    too small. For this, we need to separate the case where $u = b$ (in which case one argues directly)
    and the case where $u < b$, where one can use a point slightly to the right of $u$ which has a
    projection at distance $ > d$ of the starting point, and use almost continuity.›
    case False
    have B: "dist (p a) (p s)  d" if "s  {a..u}" for s
    proof (cases "s = u")
      case True
      show ?thesis
        unfolding True using False by auto
    next
      case False
      then show ?thesis
        using that A by auto
    qed
    have C: "dist (p a) (p u)  d - 4 *delta - 2 * C"
    proof (cases "u = b")
      case True
      have "d  dist (p a) (p b)"
        using assms by auto
      also have "...  dist (p a) (p u) + dist (p u) (p b)"
        by (intro mono_intros)
      also have "...  dist (p a) (p u) + (dist (f u) (f b) + 4 * deltaG TYPE('a) + 2 * C)"
        apply (intro mono_intros proj_along_quasiconvex_contraction'[OF ‹quasiconvex C G])
        using assms a  u u  b by auto
      finally show ?thesis
        unfolding True using ‹deltaG(TYPE('a)) < delta by auto
    next
      case False
      then have "u < b"
        using u  b by auto
      define e::real where "e = min (e0/2) ((b-u)/2)"
      then have "e > 0" using u < b e0 > 0 by auto
      define v where "v = u + e"
      then have "u < v"
        using e > 0 by auto
      have "e  b - u" "a - u  e"
        using e > 0 a  u unfolding e_def by (auto simp add: min_def)
      then have "v  {a..b}"
        unfolding v_def by auto
      moreover have "v  I"
        using u < v ‹bdd_above I cSup_upper not_le unfolding u_def by auto
      ultimately have "w  {a..v}. dist (p a) (p w) > d"
        unfolding I_def by force
      then obtain w where w: "w  {a..v}" "dist (p a) (p w) > d"
        by auto
      then have "w  {a..u}"
        using B by force
      then have "u < w"
        using w(1) by auto
      have "w  {a..b}"
        using w(1) v  {a..b} by auto
      have "dist u w = w - u"
        unfolding dist_real_def using u < w by auto
      also have "...  v - u"
        using w(1) by auto
      also have "... < e0"
        unfolding v_def e_def min_def using e0 > 0 by auto
      finally have "dist u w < e0" by simp
      have "dist (p u) (p w)  dist (f u) (f w) + 4 * deltaG(TYPE('a)) + 2 * C"
        apply (rule proj_along_quasiconvex_contraction'[OF ‹quasiconvex C G])
        using assms a  u u  b w  {a..b} by auto
      also have "...  (delta - deltaG(TYPE('a))) + 4 * deltaG(TYPE('a)) + 2 * C"
        apply (intro mono_intros)
        using e0(2)[OF w  {a..b} ‹dist u w < e0] by (auto simp add: metric_space_class.dist_commute)
      finally have I: "dist (p u) (p w)  4 * delta + 2 * C"
        using delta > deltaG(TYPE('a)) by simp
      have "d  dist (p a) (p u) + dist (p u) (p w)"
        using w(2) metric_space_class.dist_triangle[of "p a" "p w" "p u"] by auto
      also have "...  dist (p a) (p u) + 4 * delta + 2 * C"
        using I by auto
      finally show ?thesis by simp
    qed
    show ?thesis
      apply (rule bexI[of _ u])
      using B a  u u  b C by auto
  qed
qed

text ‹Same lemma, except that one exchanges the roles of the beginning and the end point.›

lemma (in Gromov_hyperbolic_space_geodesic) quasi_convex_projection_small_gaps':
  assumes "continuous_on {a..(b::real)} f"
          "a  b"
          "quasiconvex C G"
          "x. x  {a..b}  p x  proj_set (f x) G"
          "delta > deltaG(TYPE('a))"
          "d  {4 * delta + 2 * C..dist (p a) (p b)}"
  shows "t  {a..b}. dist (p b) (p t)  {d - 4 * delta - 2 * C .. d}
                     (s  {t..b}. dist (p b) (p s)  d)"
proof -
  have *: "continuous_on {-b..-a} (λt. f(-t))"
    using continuous_on_compose[of "{-b..-a}" "λt. -t" f] using assms(1) continuous_on_minus[OF continuous_on_id] by auto
  define q where "q = (λt. p(-t))"
  have "t  {-b..-a}. (dist (q (-b)) (q t)  {d - 4 * delta - 2 * C .. d})
                     (s  {-b..t}. dist (q (-b)) (q s)  d)"
    apply (rule quasi_convex_projection_small_gaps[where ?f = "λt. f(-t)" and ?G = G])
    unfolding q_def using assms * by (auto simp add: metric_space_class.dist_commute)
  then obtain t where t: "t  {-b..-a}" "dist (q (-b)) (q t)  {d - 4 * delta - 2 * C .. d}"
                      "s. s  {-b..t}  dist (q (-b)) (q s)  d"
    by blast
  have *: "dist (p b) (p s)  d" if "s  {-t..b}" for s
    using t(3)[of "-s"] that q_def by auto
  show ?thesis
    apply (rule bexI[of _ "-t"]) using t * q_def by auto
qed

section ‹The Morse-Gromov Theorem›

text ‹The goal of this section is to prove a central basic result in the theory of hyperbolic spaces,
usually called the Morse Lemma. It is really
a theorem, and we add the name Gromov the avoid the confusion with the other Morse lemma
on the existence of good coordinates for $C^2$ functions with non-vanishing hessian.

It states that a quasi-geodesic remains within bounded distance of a geodesic with the same
endpoints, the error depending only on $\delta$ and on the parameters $(\lambda, C)$ of the
quasi-geodesic, but not on its length.

There are several proofs of this result. We will follow the one of Shchur~\cite{shchur}, which
gets an optimal dependency in terms of the parameters of the quasi-isometry, contrary to all
previous proofs. The price to pay is that the proof is more involved (relying in particular on
the fact that the closest point projection on quasi-convex sets is exponentially contracting).

We will also give afterwards for completeness the proof in~\cite{bridson_haefliger}, as it brings
up interesting tools, although the dependency it gives is worse.›

text ‹The next lemma (for $C = 0$, Lemma 2 in~\cite{shchur}) asserts that, if two points are not too far apart (at distance at most
$10 \delta$), and far enough from a given geodesic segment, then when one moves towards this
geodesic segment by a fixed amount (here $5 \delta$), then the two points become closer (the new
distance is at most $5 \delta$, gaining a factor of $2$). Later, we will iterate this lemma to
show that the projection on a geodesic segment is exponentially contracting. For the application,
we give a more general version involving an additional constant $C$.

This lemma holds for $\delta$ the hyperbolicity constant. We will want to apply it with $\delta > 0$,
so to avoid problems in the case $\delta = 0$ we formulate it not using the hyperbolicity constant of
the given type, but any constant which is at least the hyperbolicity constant (this is to work
around the fact that one can not say or use easily in Isabelle that a type with hyperbolicity
$\delta$ is also hyperbolic for any larger constant $\delta'$.›

lemma (in Gromov_hyperbolic_space_geodesic) geodesic_projection_exp_contracting_aux:
  assumes "geodesic_segment G"
          "px  proj_set x G"
          "py  proj_set y G"
          "delta  deltaG(TYPE('a))"
          "dist x y  10 * delta + C"
          "M  15/2 * delta"
          "dist px x  M + 5 * delta + C/2"
          "dist py y  M + 5 * delta + C/2"
          "C  0"
  shows "dist (geodesic_segment_param {px--x} px M)
              (geodesic_segment_param {py--y} py M)  5 * delta"
proof -
  have "dist px x  dist py x"
    using proj_setD(2)[OF assms(2)] infdist_le[OF proj_setD(1)[OF assms(3)], of x] by (simp add: metric_space_class.dist_commute)
  have "dist py y  dist px y"
    using proj_setD(2)[OF assms(3)] infdist_le[OF proj_setD(1)[OF assms(2)], of y] by (simp add: metric_space_class.dist_commute)

  have "delta  0"
    using assms local.delta_nonneg by linarith
  then have M: "M  0" "M  dist px x" "M  dist px y" "M  dist py x" "M  dist py y"
    using assms ‹dist px x  dist py x ‹dist py y  dist px yby auto
  have "px  G" "py  G"
    using assms proj_setD by auto

  define x' where "x' = geodesic_segment_param {px--x} px M"
  define y' where "y' = geodesic_segment_param {py--y} py M"

  text ‹First step: the distance between $px$ and $py$ is at most $5\delta$.›
  have "dist px py  max (5 * deltaG(TYPE('a))) (dist x y - dist px x - dist py y + 10 * deltaG(TYPE('a)))"
    by (rule proj_along_geodesic_contraction[OF assms(1) assms(2) assms(3)])
  also have "...  max (5 * deltaG(TYPE('a))) (5 * deltaG(TYPE('a)))"
    apply (intro mono_intros) using assms delta  0 by auto
  finally have "dist px py  5 * delta"
    using delta  deltaG(TYPE('a)) by auto

  text ‹Second step: show that all the interesting Gromov products at bounded below by $M$.›
  have *: "x'  {px--x}" unfolding x'_def
    by (simp add: geodesic_segment_param_in_segment)
  have "px  proj_set x' G"
    by (rule proj_set_geodesic_same_basepoint[OF px  proj_set x G _ *], auto)
  have "dist px x' = M"
    unfolding x'_def using M by auto
  have "dist px x'  dist py x'"
    using proj_setD(2)[OF px  proj_set x' G] infdist_le[OF proj_setD(1)[OF assms(3)], of x'] by (simp add: metric_space_class.dist_commute)
  have **: "dist px x = dist px x' + dist x' x"
    using geodesic_segment_dist[OF _ *, of px x] by auto
  have Ixx: "Gromov_product_at px x' x = M"
    unfolding Gromov_product_at_def ** x'_def using M by auto
  have "2 * M = dist px x' + dist px x - dist x' x"
    unfolding ** x'_def using M by auto
  also have "...  dist py x' + dist py x - dist x' x"
    apply (intro mono_intros, auto) by fact+
  also have "... = 2 * Gromov_product_at py x x'"
    unfolding Gromov_product_at_def by (auto simp add: metric_space_class.dist_commute)
  finally have Iyx: "Gromov_product_at py x x'  M" by auto

  have *: "y'  {py--y}" unfolding y'_def
    by (simp add: geodesic_segment_param_in_segment)
  have "py  proj_set y' G"
    by (rule proj_set_geodesic_same_basepoint[OF py  proj_set y G _ *], auto)
  have "dist py y' = M"
    unfolding y'_def using M by auto
  have "dist py y'  dist px y'"
    using proj_setD(2)[OF py  proj_set y' G] infdist_le[OF proj_setD(1)[OF assms(2)], of y'] by (simp add: metric_space_class.dist_commute)
  have **: "dist py y = dist py y' + dist y' y"
    using geodesic_segment_dist[OF _ *, of py y] by auto
  have Iyy: "Gromov_product_at py y' y = M"
    unfolding Gromov_product_at_def ** y'_def using M by auto
  have "2 * M = dist py y' + dist py y - dist y' y"
    unfolding ** y'_def using M by auto
  also have "...  dist px y' + dist px y - dist y' y"
    apply (intro mono_intros, auto) by fact+
  also have "... = 2 * Gromov_product_at px y y'"
    unfolding Gromov_product_at_def by (auto simp add: metric_space_class.dist_commute)
  finally have Ixy: "Gromov_product_at px y y'  M" by auto

  have "2 * M  dist px x + dist py y - dist x y"
    using assms by auto
  also have "...  dist px x + dist px y - dist x y"
    by (intro mono_intros, fact)
  also have "... = 2 * Gromov_product_at px x y"
    unfolding Gromov_product_at_def by auto
  finally have Ix: "Gromov_product_at px x y  M"
    by auto
  have "2 * M  dist px x + dist py y - dist x y"
    using assms by auto
  also have "...  dist py x + dist py y - dist x y"
    by (intro mono_intros, fact)
  also have "... = 2 * Gromov_product_at py x y"
    unfolding Gromov_product_at_def by auto
  finally have Iy: "Gromov_product_at py x y  M"
    by auto

  text ‹Third step: prove the estimate›
  have "M - 2 * delta  Min {Gromov_product_at px x' x, Gromov_product_at px x y, Gromov_product_at px y y'} - 2 * deltaG(TYPE('a))"
    using Ixx Ixy Ix delta  deltaG(TYPE('a)) by auto
  also have "...  Gromov_product_at px x' y'"
    by (intro mono_intros)
  finally have A: "M - 4 * delta + dist x' y'  dist px y'"
    unfolding Gromov_product_at_def ‹dist px x' = M by auto

  have "M - 2 * delta  Min {Gromov_product_at py x' x, Gromov_product_at py x y, Gromov_product_at py y y'} - 2 * deltaG(TYPE('a))"
    using Iyx Iyy Iy delta  deltaG(TYPE('a)) by (auto simp add: Gromov_product_commute)
  also have "...  Gromov_product_at py x' y'"
    by (intro mono_intros)
  finally have B: "M - 4 * delta + dist x' y'  dist py x'"
    unfolding Gromov_product_at_def ‹dist py y' = M by auto

  have "dist px py  2 * M - 10 * delta"
    using assms ‹dist px py  5 * delta by auto
  have "2 * M - 8 * delta + 2 * dist x' y'  dist px y' + dist py x'"
    using A B by auto
  also have "...  max (dist px py + dist y' x') (dist px x' + dist y' py) + 2 * deltaG TYPE('a)"
    by (rule hyperb_quad_ineq)
  also have "...  max (dist px py + dist y' x') (dist px x' + dist y' py) + 2 * delta"
    using ‹deltaG(TYPE('a))  delta by auto
  finally have "2 * M - 10 * delta + 2 * dist x' y'  max (dist px py + dist y' x') (dist px x' + dist y' py)"
    by auto
  then have "2 * M - 10 * delta + 2 * dist x' y'  dist px x' + dist py y'"
    apply (auto simp add: metric_space_class.dist_commute)
    using 0  delta ‹dist px py  2 * M - 10 * delta ‹dist px x' = M ‹dist py y' = M by auto
  then have "dist x' y'  5 * delta"
    unfolding ‹dist px x' = M ‹dist py y' = M by auto
  then show ?thesis
    unfolding x'_def y'_def by auto
qed

text ‹The next lemma (Lemma 10 in~\cite{shchur} for $C = 0$) asserts that the projection on a geodesic segment is
an exponential contraction.
More precisely, if a path of length $L$ is at distance at least $D$ of a geodesic segment $G$,
then the projection of the path on $G$ has diameter at most $C L \exp(-c D/\delta)$, where $C$ and
$c$ are universal constants. This is not completely true at one can not go below a fixed size, as
always, so the correct bound is $K \max(\delta, L \exp(-c D/\delta))$. For the application, we
give a slightly more general statement involving an additional constant $C$.

This statement follows from the previous lemma: if one moves towards $G$ by $10 \delta$, then
the distance between points is divided by $2$. Then one iterates this statement as many times
as possible, gaining a factor $2$ each time and therefore an exponential factor in the end.›

lemma (in Gromov_hyperbolic_space_geodesic) geodesic_projection_exp_contracting:
  assumes "geodesic_segment G"
          "x y. x  {a..b}  y  {a..b}  dist (f x) (f y)  lambda * dist x y + C"
          "a  b"
          "pa  proj_set (f a) G"
          "pb  proj_set (f b) G"
          "t. t  {a..b}  infdist (f t) G  D"
          "D  15/2 * delta + C/2"
          "delta > deltaG(TYPE('a))"
          "C  0"
          "lambda  0"
  shows "dist pa pb  max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (b-a) * exp(-(D-C/2) * ln 2 / (5 * delta)))"
proof -
  have "delta > 0" using assms
    using local.delta_nonneg by linarith
  have "exp(15/2/5 * ln 2) = exp(ln 2) * exp(1/2 * ln (2::real))"
    unfolding mult_exp_exp by simp
  also have "... = 2 * exp(1/2 * ln 2)"
    by auto
  finally have "exp(15/2/5 * ln 2) = 2 * exp(1/2 * ln (2::real))"
    by simp

  text ‹The idea of the proof is to start with a sequence of points separated by $10 \delta + C$ along
  the original path, and push them by a fixed distance towards $G$ to bring them at distance at most
  $5 \delta$, thanks to the previous lemma. Then, discard half the points, and start again. This
  is possible while one is far enough from $G$. In the first step of the proof, we formalize this
  in the case where the process can be iterated long enough that, at the end, the projections on $G$
  are very close together. This is a simple induction, based on the previous lemma.›

  have Main: "c g p. (i  {0..2^k}. p i  proj_set (g i) G)
             (i  {0..2^k}. dist (p i) (g i)  5 * delta * k + 15/2 * delta + c/2)
             (i  {0..<2^k}. dist (g i) (g (Suc i))  10 * delta + c)
             c  0
             dist (p 0) (p (2^k))  5 * deltaG(TYPE('a))" for k
  proof (induction k)
    case 0
    then have H: "p 0  proj_set (g 0) G"
                 "p 1  proj_set (g 1) G"
                 "dist (g 0) (g 1)  10 * delta + c"
                 "dist (p 0) (g 0)  15/2 * delta + c/2"
                 "dist (p 1) (g 1)  15/2 * delta + c/2"
      by auto
    have "dist (p 0) (p 1)  max (5 * deltaG(TYPE('a))) (dist (g 0) (g 1) - dist (p 0) (g 0) - dist (p 1) (g 1) + 10 * deltaG(TYPE('a)))"
      by (rule proj_along_geodesic_contraction[OF ‹geodesic_segment G p 0  proj_set (g 0) G p 1  proj_set (g 1) G])
    also have "...  max (5 * deltaG(TYPE('a))) (5 * deltaG(TYPE('a)))"
      apply (intro mono_intros) using H delta > deltaG(TYPE('a)) by auto
    finally show "dist (p 0) (p (2^0))  5 * deltaG(TYPE('a))"
      by auto
  next
    case (Suc k)
    have *: "5 * delta * real (k + 1) + 5 * delta = 5 * delta * real (Suc k + 1)"
      by (simp add: algebra_simps)
    define h where "h = (λi. geodesic_segment_param {p i--g i} (p i) (5 * delta * k + 15/2 * delta))"
    have h_dist: "dist (h i) (h (Suc i))  5 * delta" if "i  {0..<2^(Suc k)}" for i
      unfolding h_def apply (rule geodesic_projection_exp_contracting_aux[OF ‹geodesic_segment G _ _ less_imp_le[OF delta > deltaG(TYPE('a))]])
      unfolding * using Suc.prems that delta > 0 by (auto simp add: algebra_simps divide_simps)
    define g' where "g' = (λi. h (2 * i))"
    define p' where "p' = (λi. p (2 * i))"
    have "dist (p' 0) (p' (2^k))  5 * deltaG(TYPE('a))"
    proof (rule Suc.IH[where ?g = g' and ?c = 0])
      show "i{0..2 ^ k}. p' i  proj_set (g' i) G"
      proof
        fix i::nat assume "i  {0..2^k}"
        then have *: "2 * i  {0..2^(Suc k)}" by auto
        show "p' i  proj_set (g' i) G"
          unfolding p'_def g'_def h_def apply (rule proj_set_geodesic_same_basepoint[of _ "g (2 * i)" _ "{p(2 * i)--g(2 * i)}"])
          using Suc * by (auto simp add: geodesic_segment_param_in_segment)
      qed
      show "i{0..2 ^ k}. 5 * delta * k + 15/2 * delta + 0/2  dist (p' i) (g' i)"
      proof
        fix i::nat assume "i  {0..2^k}"
        then have *: "2 * i  {0..2^(Suc k)}" by auto
        have "5 * delta * k + 15/2 * delta  5 * delta * Suc k + 15/2 * delta + c/2"
          using delta > 0 c  0 by (auto simp add: algebra_simps divide_simps)
        also have "...  dist (p (2 * i)) (g (2 * i))"
          using Suc * by auto
        finally have *: "5 * delta * k + 15/2 * delta  dist (p (2 * i)) (g (2 * i))" by simp
        have "dist (p' i) (g' i) = 5 * delta * k + 15/2 * delta"
          unfolding p'_def g'_def h_def apply (rule geodesic_segment_param_in_geodesic_spaces(6))
          using * delta > 0 by auto
        then show "5 * delta * k + 15/2 * delta + 0/2  dist (p' i) (g' i)" by simp
      qed
      show "i{0..<2 ^ k}. dist (g' i) (g' (Suc i))  10 * delta + 0"
      proof
        fix i::nat assume *: "i  {0..<2 ^ k}"
        have "dist (g' i) (g' (Suc i)) = dist (h (2 * i)) (h (Suc (Suc (2 * i))))"
          unfolding g'_def by auto
        also have "...  dist (h (2 * i)) (h (Suc (2 * i))) + dist (h (Suc (2 * i))) (h (Suc (Suc (2 * i))))"
          by (intro mono_intros)
        also have "...  5 * delta + 5 * delta"
          apply (intro mono_intros h_dist) using * by auto
        finally show "dist (g' i) (g' (Suc i))  10 * delta + 0" by simp
      qed
    qed (simp)
    then show "dist (p 0) (p (2 ^ Suc k))  5 * deltaG(TYPE('a))"
      unfolding p'_def by auto
  qed

  text ‹Now, we will apply the previous basic statement to points along our original path. We
  introduce $k$, the number of steps for which the pushing process can be done -- it only depends on
  the original distance $D$ to $G$. ›

  define k where "k = nat(floor((D - C/2 - 15/2 * delta)/(5 * delta)))"
  have "int k = floor((D - C/2 - 15/2 * delta)/(5 * delta))"
    unfolding k_def apply (rule nat_0_le) using D  15/2 * delta + C/2 delta > 0 by auto
  then have "k  (D - C/2 - 15/2 * delta)/(5 * delta)" "(D - C/2 - 15/2 * delta)/(5 * delta)  k + 1"
    by linarith+
  then have k: "D  5 * delta * k + 15/2 * delta + C/2" "D  5 * delta * (k+1) + 15/2 * delta + C/2"
    using delta > 0 by (auto simp add: algebra_simps divide_simps)
  have "exp((D-C/2)/(5 * delta) * ln 2) * exp(-15/2/5 * ln 2) = exp(((D-C/2-15/2 * delta)/(5 * delta)) * ln 2)"
    unfolding mult_exp_exp using delta > 0 by (simp add: algebra_simps divide_simps)
  also have "...  exp((k+1) * ln 2)"
    apply (intro mono_intros) using k(2) delta > 0 by (auto simp add: divide_simps algebra_simps)
  also have "... = 2^(k+1)"
    by (subst powr_realpow[symmetric], auto simp add: powr_def)
  also have "... = 2 * 2^k"
    by auto
  finally have k': "1/2^k  2 * exp(15/2/5 * ln 2) * exp(- ((D-C/2) * ln 2 / (5 * delta)))"
    by (auto simp add: algebra_simps divide_simps exp_minus)

  text ‹We separate the proof into two cases. If the path is not too long, then it can be covered by
  $2^k$ points at distance at most $10 \delta + C$. By the basic statement, it follows that the diameter
  of the projection is at most $5 \delta$. Otherwise, we subdivide the path into $2^N$ points at
  distance at most $10 \delta + C$, with $N \geq k$, and apply the basic statement to blocks of $2^k$
  consecutive points. It follows that the projections of $g_0, g_{2^k}, g_{2\cdot 2^k},\dotsc$ are
  at distances at most $5 \delta$. Hence, the first and last projections are at distance at most
  $2^{N-k} \cdot 5 \delta$, which is the desired bound.›

  show ?thesis
  proof (cases "lambda * (b-a)  10 * delta * 2^k")
    text ‹First, treat the case where the path is rather short.›
    case True
    define g::"nat  'a" where "g = (λi. f(a + (b-a) * i/2^k))"
    have "g 0 = f a" "g(2^k) = f b"
      unfolding g_def by auto
    have *: "a + (b-a) * i/2^k  {a..b}" if "i  {0..2^k}" for i::nat
    proof -
      have "a + (b - a) * (real i / 2 ^ k)  a + (b-a) * (2^k/2^k)"
        apply (intro mono_intros) using that a  b by auto
      then show ?thesis using a  b by auto
    qed
    have A: "dist (g i) (g (Suc i))  10 * delta + C" if "i  {0..<2^k}" for i
    proof -
      have "dist (g i) (g (Suc i))  lambda * dist (a + (b-a) * i/2^k) (a + (b-a) * (Suc i)/2^k) + C"
        unfolding g_def apply (intro assms(2) *) using that by auto
      also have "... = lambda * (b-a)/2^k + C"
        unfolding dist_real_def using a  b by (auto simp add: algebra_simps divide_simps)
      also have "...  10 * delta + C"
        using True by (simp add: divide_simps algebra_simps)
      finally show ?thesis by simp
    qed
    define p where "p = (λi. if i = 0 then pa else if i = 2^k then pb else SOME p. p  proj_set (g i) G)"
    have B: "p i  proj_set (g i) G" if "i  {0..2^k}" for i
    proof (cases "i = 0  i = 2^k")
      case True
      then show ?thesis
        using pa  proj_set (f a) G pb  proj_set (f b) G unfolding p_def g_def by auto
    next
      case False
      then have "p i = (SOME p. p  proj_set (g i) G)"
        unfolding p_def by auto
      moreover have "proj_set (g i) G  {}"
        apply (rule proj_set_nonempty_of_proper) using geodesic_segment_topology[OF ‹geodesic_segment G] by auto
      ultimately show ?thesis
        using some_in_eq by auto
    qed
    have C: "dist (p i) (g i)  5 * delta * k + 15/2 * delta + C/2" if "i  {0..2^k}" for i
    proof -
      have "5 * delta * k + 15/2 * delta + C/2  D"
        using k(1) by simp
      also have "...  infdist (g i) G"
        unfolding g_def apply (rule t. t  {a..b}  infdist (f t) G  D) using * that by auto
      also have "... = dist (p i) (g i)"
        using that proj_setD(2)[OF B[OF that]] by (simp add: metric_space_class.dist_commute)
      finally show ?thesis by simp
    qed
    have "dist (p 0) (p (2^k))  5 * deltaG(TYPE('a))"
      apply (rule Main[where ?g = g and ?c = C]) using A B C C  0 by auto
    then show ?thesis
      unfolding p_def by auto
  next
    text ‹Now, the case where the path is long. We introduce $N$ such that it is roughly of length
    $2^N \cdot 10 \delta$.›
    case False
    have *: "10 * delta * 2^k  lambda * (b-a)" using False by simp
    have "lambda * (b-a) > 0"
      using delta > 0 False 0  lambda assms(3) less_eq_real_def mult_le_0_iff by auto
    then have "a < b" "lambda > 0"
      using a  b lambda  0 less_eq_real_def by auto
    define n where "n = nat(floor(log 2 (lambda * (b-a)/(10 * delta))))"
    have "log 2 (lambda * (b-a)/(10 * delta))  log 2 (2^k)"
      apply (subst log_le_cancel_iff)
      using * delta > 0 a < b lambda > 0 by (auto simp add: divide_simps algebra_simps)
    moreover have "log 2 (2^k) = k"
      by simp
    ultimately have A: "log 2 (lambda * (b-a)/(10 * delta))  k" by auto
    have **: "int n = floor(log 2 (lambda * (b-a)/(10 * delta)))"
      unfolding n_def apply (rule nat_0_le) using A by auto
    then have "log 2 (2^n)  log 2 (lambda * (b-a)/(10 * delta))"
      apply (subst log_nat_power, auto) by linarith
    then have I: "2^n  lambda * (b-a)/(10 * delta)"
      using 0 < lambda * (b - a) 0 < delta
      by (simp add: le_log_iff powr_realpow)
    have "log 2 (lambda * (b-a)/(10 * delta))  log 2 (2^(n+1))"
      apply (subst log_nat_power, auto) using ** by linarith
    then have J: "lambda * (b-a)/(10 * delta)  2^(n+1)"
      using 0 < lambda * (b - a) 0 < delta by auto
    have K: "k  n" using A ** by linarith
    define N where "N = n+1"
    have N: "k+1  N" "lambda * (b-a) / 2^N  10 *delta" "2 ^ N  lambda * (b - a) / (5 * delta)"
      using I J K delta > 0 unfolding N_def by (auto simp add: divide_simps algebra_simps)
    then have "2 ^ k  (0::real)" "k  N"
      by auto
    then have "(2^(N-k)::real) = 2^N/2^k"
      by (metis (no_types) add_diff_cancel_left' le_Suc_ex nonzero_mult_div_cancel_left power_add)

    text ‹Define $2^N$ points along the path, separated by at most $10\delta$, and their projections.›
    define g::"nat  'a" where "g = (λi. f(a + (b-a) * i/2^N))"
    have "g 0 = f a" "g(2^N) = f b"
      unfolding g_def by auto
    have *: "a + (b-a) * i/2^N  {a..b}" if "i  {0..2^N}" for i::nat
    proof -
      have "a + (b - a) * (real i / 2 ^ N)  a + (b-a) * (2^N/2^N)"
        apply (intro mono_intros) using that a  b by auto
      then show ?thesis using a  b by auto
    qed
    have A: "dist (g i) (g (Suc i))  10 * delta + C" if "i  {0..<2^N}" for i
    proof -
      have "dist (g i) (g (Suc i))  lambda * dist (a + (b-a) * i/2^N) (a + (b-a) * (Suc i)/2^N) + C"
        unfolding g_def apply (intro assms(2) *)
        using that by auto
      also have "... = lambda * (b-a)/2^N + C"
        unfolding dist_real_def using a  b by (auto simp add: algebra_simps divide_simps)
      also have "...  10 * delta + C"
        using N by simp
      finally show ?thesis by simp
    qed
    define p where "p = (λi. if i = 0 then pa else if i = 2^N then pb else SOME p. p  proj_set (g i) G)"
    have B: "p i  proj_set (g i) G" if "i  {0..2^N}" for i
    proof (cases "i = 0  i = 2^N")
      case True
      then show ?thesis
        using pa  proj_set (f a) G pb  proj_set (f b) G unfolding p_def g_def by auto
    next
      case False
      then have "p i = (SOME p. p  proj_set (g i) G)"
        unfolding p_def by auto
      moreover have "proj_set (g i) G  {}"
        apply (rule proj_set_nonempty_of_proper) using geodesic_segment_topology[OF ‹geodesic_segment G] by auto
      ultimately show ?thesis
        using some_in_eq by auto
    qed
    have C: "dist (p i) (g i)  5 * delta * k + 15/2 * delta + C/2" if "i  {0..2^N}" for i
    proof -
      have "5 * delta * k + 15/2 * delta + C/2  D"
        using k(1) by simp
      also have "...  infdist (g i) G"
        unfolding g_def apply (rule t. t  {a..b}  infdist (f t) G  D) using * that by auto
      also have "... = dist (p i) (g i)"
        using that proj_setD(2)[OF B[OF that]] by (simp add: metric_space_class.dist_commute)
      finally show ?thesis by simp
    qed
    text ‹Use the basic statement to show that, along packets of size $2^k$, the projections
    are within $5\delta$ of each other.›
    have I: "dist (p (2^k * j)) (p (2^k * (Suc j)))  5 * delta" if "j  {0..<2^(N-k)}" for j
    proof -
      have I: "i + 2^k * j  {0..2^N}" if "i  {0..2^k}" for i
      proof -
        have "i + 2 ^ k * j  2^k + 2^k * (2^(N-k)-1)"
          apply (intro mono_intros) using that j  {0..<2^(N-k)} by auto
        also have "... = 2^N"
          using k +1  N by (auto simp add: algebra_simps semiring_normalization_rules(26))
        finally show ?thesis by auto
      qed
      have I': "i + 2^k * j  {0..<2^N}" if "i  {0..<2^k}" for i
      proof -
        have "i + 2 ^ k * j < 2^k + 2^k * (2^(N-k)-1)"
          apply (intro mono_intros) using that j  {0..<2^(N-k)} by auto
        also have "... = 2^N"
          using k +1  N by (auto simp add: algebra_simps semiring_normalization_rules(26))
        finally show ?thesis by auto
      qed
      define g' where "g' = (λi. g (i + 2^k * j))"
      define p' where "p' = (λi. p (i + 2^k * j))"
      have "dist (p' 0) (p' (2^k))  5 * deltaG(TYPE('a))"
        apply (rule Main[where ?g = g' and ?c = C]) unfolding p'_def g'_def using A B C I I' C  0 by auto
      also have "...  5 * delta"
        using ‹deltaG(TYPE('a)) < delta by auto
      finally show ?thesis
        unfolding p'_def by auto
    qed
    text ‹Control the total distance by adding the contributions of blocks of size $2^k$.›
    have *: "dist (p 0) (p(2^k * j))  (i<j. dist (p (2^k * i)) (p (2^k * (Suc i))))" for j
    proof (induction j)
      case (Suc j)
      have "dist (p 0) (p(2^k * (Suc j)))  dist (p 0) (p(2^k * j)) + dist (p(2^k * j)) (p(2^k * (Suc j)))"
        by (intro mono_intros)
      also have "...  (i<j. dist (p (2^k * i)) (p (2^k * (Suc i)))) + dist (p(2^k * j)) (p(2^k * (Suc j)))"
        using Suc.IH by auto
      also have "... = (i<Suc j. dist (p (2^k * i)) (p (2^k * (Suc i))))"
        by auto
      finally show ?case by simp
    qed (auto)
    have "dist pa pb = dist (p 0) (p (2^N))"
      unfolding p_def by auto
    also have "... = dist (p 0) (p (2^k * 2^(N-k)))"
      using k +1  N by (auto simp add: semiring_normalization_rules(26))
    also have "...  (i<2^(N-k). dist (p (2^k * i)) (p (2^k * (Suc i))))"
      using * by auto
    also have "...  ((i::nat)<2^(N-k). 5 * delta)"
      apply (rule sum_mono) using I by auto
    also have "... = 5 * delta * 2^(N-k)"
      by auto
    also have "... = 5 * delta * 2^N * (1/ 2^k)"
      unfolding (2^(N-k)::real) = 2^N/2^k by simp
    also have "...  5 * delta * (2 * lambda * (b-a)/(10 * delta)) * (2 * exp(15/2/5 * ln 2) * exp(- ((D-C/2) * ln 2 / (5 * delta))))"
      apply (intro mono_intros) using delta > 0 lambda > 0 a < b k' N by auto
    also have "... = (2 * exp(15/2/5 * ln 2)) * lambda * (b-a) * exp(-(D-C/2) * ln 2 / (5 * delta))"
      using delta > 0 by (auto simp add: algebra_simps divide_simps)
    finally show ?thesis
      unfolding ‹exp(15/2/5 * ln 2) = 2 * exp(1/2 * ln (2::real)) by auto
  qed
qed

text ‹We deduce from the previous result that a projection on a quasiconvex set is also
exponentially contracting. To do this, one uses the contraction of a projection on a geodesic, and
one adds up the additional errors due to the quasi-convexity. In particular, the projections on the
original quasiconvex set or the geodesic do not have to coincide, but they are within distance at
most $C + 8 \delta$.›

lemma (in Gromov_hyperbolic_space_geodesic) quasiconvex_projection_exp_contracting:
  assumes "quasiconvex K G"
          "x y. x  {a..b}  y  {a..b}  dist (f x) (f y)  lambda * dist x y + C"
          "a  b"
          "pa  proj_set (f a) G"
          "pb  proj_set (f b) G"
          "t. t  {a..b}  infdist (f t) G  D"
          "D  15/2 * delta + K + C/2"
          "delta > deltaG(TYPE('a))"
          "C  0"
          "lambda  0"
  shows "dist pa pb  2 * K + 8 * delta + max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (b-a) * exp(-(D - K - C/2) * ln 2 / (5 * delta)))"
proof -
  obtain H where H: "geodesic_segment_between H pa pb" "q. q  H  infdist q G  K"
    using quasiconvexD[OF assms(1) proj_setD(1)[OF pa  proj_set (f a) G] proj_setD(1)[OF pb  proj_set (f b) G]] by auto
  obtain qa where qa: "qa  proj_set (f a) H"
    using proj_set_nonempty_of_proper[of H "f a"] geodesic_segment_topology[OF geodesic_segmentI[OF H(1)]] by auto
  obtain qb where qb: "qb  proj_set (f b) H"
    using proj_set_nonempty_of_proper[of H "f b"] geodesic_segment_topology[OF geodesic_segmentI[OF H(1)]] by auto

  have I: "infdist (f t) H  D - K" if "t  {a..b}" for t
  proof -
    have *: "D - K  dist (f t) h" if "h  H" for h
    proof -
      have "D - K - dist (f t) h  e" if "e > 0" for e
      proof -
        have *: "infdist h G < K + e" using H(2)[OF h  H] e > 0 by auto
        obtain g where g: "g  G" "dist h g < K + e"
          using infdist_almost_attained[OF *] proj_setD(1)[OF pa  proj_set (f a) G] by auto
        have "D  dist (f t) g"
          using t. t  {a..b}  infdist (f t) G  D[OF t  {a..b}] infdist_le[OF g  G, of "f t"] by auto
        also have "...  dist (f t) h + dist h g"
          by (intro mono_intros)
        also have "...  dist (f t) h + K + e"
          using g(2) by auto
        finally show ?thesis by auto
      qed
      then have *: "D - K - dist (f t) h  0"
        using dense_ge by blast
      then show ?thesis by simp
    qed
    have "D - K  Inf (dist (f t) ` H)"
      apply (rule cInf_greatest) using * H(1) by auto
    then show "D - K  infdist (f t) H"
      apply (subst infdist_notempty) using H(1) by auto
  qed
  have Q: "dist qa qb  max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (b-a) * exp(-((D - K)-C/2 ) * ln 2 / (5 * delta)))"
    apply (rule geodesic_projection_exp_contracting[OF geodesic_segmentI[OF ‹geodesic_segment_between H pa pb] assms(2) assms(3)])
    using qa qb I assms by auto

  have A: "dist pa qa  4 * delta + K"
  proof -
    have "dist (f a) pa - dist (f a) qa - K  e" if "e > 0" for e::real
    proof -
      have *: "infdist qa G < K + e" using H(2)[OF proj_setD(1)[OF qa]] e > 0 by auto
      obtain g where g: "g  G" "dist qa g < K + e"
        using infdist_almost_attained[OF *] proj_setD(1)[OF pa  proj_set (f a) G] by auto
      have "dist (f a) pa  dist (f a) g"
        unfolding proj_setD(2)[OF pa  proj_set (f a) G] using infdist_le[OF g  G, of "f a"] by simp
      also have "...  dist (f a) qa + dist qa g"
        by (intro mono_intros)
      also have "...  dist (f a) qa + K + e"
        using g(2) by auto
      finally show ?thesis by simp
    qed
    then have I: "dist (f a) pa - dist (f a) qa - K  0"
      using dense_ge by blast
    have "dist (f a) qa + dist qa pa  dist (f a) pa + 4 * deltaG(TYPE('a))"
      apply (rule dist_along_geodesic[OF geodesic_segmentI[OF H(1)]]) using qa H(1) by auto
    also have "...  dist (f a) qa + K + 4 * delta"
      using I assms by auto
    finally show ?thesis
      by (simp add: metric_space_class.dist_commute)
  qed
  have B: "dist qb pb  4 * delta + K"
  proof -
    have "dist (f b) pb - dist (f b) qb - K  e" if "e > 0" for e::real
    proof -
      have *: "infdist qb G < K + e" using H(2)[OF proj_setD(1)[OF qb]] e > 0 by auto
      obtain g where g: "g  G" "dist qb g < K + e"
        using infdist_almost_attained[OF *] proj_setD(1)[OF pa  proj_set (f a) G] by auto
      have "dist (f b) pb  dist (f b) g"
        unfolding proj_setD(2)[OF pb  proj_set (f b) G] using infdist_le[OF g  G, of "f b"] by simp
      also have "...  dist (f b) qb + dist qb g"
        by (intro mono_intros)
      also have "...  dist (f b) qb + K + e"
        using g(2) by auto
      finally show ?thesis by simp
    qed
    then have I: "dist (f b) pb - dist (f b) qb - K  0"
      using dense_ge by blast
    have "dist (f b) qb + dist qb pb  dist (f b) pb + 4 * deltaG(TYPE('a))"
      apply (rule dist_along_geodesic[OF geodesic_segmentI[OF H(1)]]) using qb H(1) by auto
    also have "...  dist (f b) qb + K + 4 * delta"
      using I assms by auto
    finally show ?thesis
      by simp
  qed
  have "dist pa pb  dist pa qa + dist qa qb + dist qb pb"
    by (intro mono_intros)
  then show ?thesis
    using Q A B by auto
qed

text ‹The next statement is the main step in the proof of the Morse-Gromov theorem given by Shchur
in~\cite{shchur}, asserting that a quasi-geodesic and a geodesic with the same endpoints are close.
We show that a point on the quasi-geodesic is close to the geodesic -- the other inequality will
follow easily later on. We also assume that the quasi-geodesic is parameterized by a Lipschitz map
-- the general case will follow as any quasi-geodesic can be approximated by a Lipschitz map with
good controls.

Here is a sketch of the proof. Fix two large constants $L \leq D$ (that we will choose carefully
to optimize the values of the constants at the end of the proof). Consider a quasi-geodesic $f$
between two points $f(u^-)$ and $f(u^+)$, and a geodesic segment $G$ between the same points.
Fix $f(z)$. We want to find a bound on $d(f(z), G)$.
1 - If this distance is smaller than $L$, we are done (and the bound is $L$).
2 - Assume it is larger.
Let $\pi_z$ be a projection of $f(z)$ on $G$ (at distance $d(f(z),G)$ of $f(z)$), and $H$ a geodesic
between $z$ and $\pi_z$. The idea will be to project the image of $f$ on $H$, and record how much
progress is made towards $f(z)$. In this proof, we will construct several points before and after
$z$. When necessary, we put an exponent $-$ on the points before $z$, and $+$ on the points after
$z$. To ease the reading, the points are ordered following the alphabetical order, i.e., $u^- \leq v
\leq w \leq x \leq y^- \leq z$.

One can find two points $f(y^-)$ and $f(y^+)$ on the left and the right of $f(z)$ that project
on $H$ roughly at distance $L$ of $\pi_z$ (up to some $O(\delta)$ -- recall that the closest point
projection is not uniquely defined, and not continuous, so we make some choice here).
Let $d^-$ be the minimal distance of $f([u^-, y^-])$ to $H$, and let $d^+$ be the minimal distance
of $f([y^+, u^+)]$ to $H$.

2.1 If the two distances $d^-$ and $d^+$ are less than $D$, then the distance between two points
realizing the minimum (say $f(c^-)$ and $f(c^+)$) is at most $2D+L$, hence $c^+ - c^-$ is controlled
(by $\lambda \cdot (2D+L) + C$) thanks to the quasi-isometry property. Therefore, $f(z)$ is not far
away from $f(c^-)$ and $f(c^+)$ (again by the quasi-isometry property). Since the distance from
these points to $\pi_z$ is controlled (by $D+L$), we get a good control on $d(f(z),\pi_z)$, as
desired.

2.2 The interesting case is when $d^-$ and $d^+$ are both $ > D$. Assume also for instance $d^- \geq
d^+$, as the other case is analogous. We will construct two points $f(v)$ and $f(x)$ with $u^- \leq
v \leq x \leq y^-$ with the following property:
\begin{equation}
\label{eq:xvK}
  K_1 e^{K_2 d(f(v), H)} \leq x-v,
\end{equation}
where $K_1$ and $K_2$ are some explicit constants (depending on $\lambda$, $\delta$, $L$ and $D$).
Let us show how this will conclude the proof. The distance from $f(v)$ to $f(c^+)$ is at most
$d(f(v),H) + L + d^+ \leq 3 d(f(v), H)$. Therefore, $c^+ - v$ is also controlled by $K' d(f(v), H)$
by the quasi-isometry property. This gives
\begin{align*}
  K &\leq K (x - v) e^{-K (c^+ - v)} \leq (e^{K (x-v)} - 1) \cdot e^{-K(c^+ - v)}
    \\& = e^{-K (c^+ - x)} - e^{-K (c^+ - v)}
    \leq e^{-K(c^+ - x)} - e^{-K (u^+ - u^-)}.
\end{align*}
This shows that, when one goes from the original quasi-geodesic $f([u^-, u^+])$ to the restricted
quasi-geodesic $f([x, c^+])$, the quantity $e^{-K \cdot}$ decreases by a fixed amount. In particular,
this process can only happen a uniformly bounded number of times, say $n$.

Let $G'$ be a geodesic between $f(x)$ and $f(c^+)$. One checks geometrically that $d(f(z), G) \leq
d(f(z), G') + (L + O(\delta))$, as both projections of $f(x)$ and $f(c^+)$ on $H$ are within
distance $L$ of $\pi_z$. Iterating the process $n$ times, one gets finally $d(f(z), G) \leq O(1) + n
(L + O(\delta))$. This is the desired bound for $d(f(z), G)$.

To complete the proof, it remains to construct the points $f(v)$ and $f(x)$ satisfying~\eqref{eq:xvK}.
This will be done through an inductive process.

Assume first that there is a point $f(v)$ whose projection on $H$ is close to the projection of
$f(u^-)$, and with $d(f(v), H) \leq 2 d^-$. Then the projections of $f(v)$ and $f(y^-)$ are far away
(at distance at least $L + O(\delta)$). Since the portion of $f$ between $v$ and $y^-$ is everywhere
at distance at least $d^-$ of $H$, the projection on $H$ contracts by a factor $e^{-d^-}$. It
follows that this portion of $f$ has length at least $e^{d^-} \cdot (L+O(\delta))$. Therefore, by
the quasi-isometry property, one gets $x - v \geq K e^{d^-}$. On the other hand, $d(v, H)$ is
bounded above by $2 d^-$ by assumption. This gives the desired inequality~\eqref{eq:xvK} with $x =
y^-$.

Otherwise, all points $f(v)$ whose projection on $H$ is close to the projection of $f(u^-)$ are such
that $d(f(v), H) \geq 2 d^-$. Consider $f(w_1)$ a point whose projection on $H$ is at distance
roughly $10 \delta$ of the projection of $f(u^-)$. Let $V_1$ be the set of points at distance at
most $d^-$ of $H$, i.e., the $d_1$-neighborhood of $H$. Then the distance between the projections of
$f(u^-)$ and $f(w_1)$ on $V_1$ is very large (are there is an additional big contraction to go from
$V_1$ to $H$). And moreover all the intermediate points $f(v)$ are at distance at least $2 d^-$ of
$H$, and therefore at distance at least $d^-$ of $H$. Then one can play the same game as in the
first case, where $y^-$ replaced by $w_1$ and $H$ replaced by $V_1$. If there is a point $f(v)$
whose projection on $V_1$ is close to the projection of $f(u^-)$, then the pair of points $v$ and $x
= w_1$ works. Otherwise, one lifts everything to $V_2$, the neighborhood of size $2d^-$ of $V_1$,
and one argues again in the same way.

The induction goes on like this until one finds a suitable pair of points. The process has indeed to
stop at one time, as it can only go on while $f(u^-)$ is outside of $V_k$, the $(2^k-1) d^-$
neighborhood of $H$). This concludes the sketch of the proof, modulo the adjustment of constants.

Comments on the formalization below:
\begin{itemize}
\item The proof is written as an induction on $u^+ - u^-$. This makes it possible to either prove
the bound directly (in the cases 1 and 2.1 above), or to use the bound on $d(z, G')$ in case 2.2
using the induction assumption, and conclude the proof. Of course, $u^+ - u^-$ is not integer-valued,
but in the reduction to $G'$ it decays by a fixed amount, so one can easily write this down as
a genuine induction.
\item The main difficulty in the proof is to construct the pair $(v, x)$ in case 2.2. This is again
written as an induction over $k$: either the required bound is true, or one can find a point $f(w)$
whose projection on $V_k$ is far enough from the projection of $f(u^-)$. Then, either one can use
this point to prove the bound, or one can construct a point with the same property with respect to
$V_{k+1}$, concluding the induction.
\item Instead of writing $u^-$ and $u^+$ (which are not good variable names in Isabelle), we write
$um$ and $uM$. Similarly for other variables.
\item The proof only works when $\delta > 0$ (as one needs to divide by $\delta$
in the exponential gain). Hence, we formulate it for some $\delta$ which is
strictly larger than the hyperbolicity constant. In a subsequent application of
the lemma, we will deduce the same statement for the hyperbolicity constant
by a limiting argument.
\item To optimize the value of the constant in the end, there is an additional important trick with
respect to the above sketch: in case 2.2, there is an exponential gain. One can spare a fraction
$(1-\alpha)$ of this gain to improve the constants, and spend the remaining fraction $\alpha$ to
make the argument work. This makes it possible to reduce the value of the constant roughly from
$40000$ to $100$, so we do it in the proof below. The values of $L$, $D$ and $\alpha$ can be chosen
freely, and have been chosen to get the best possible constant in the end.
\item For another optimization, we do not induce in terms of the distance from $f(z)$ to the geodesic
$G$, but rather in terms of the Gromov product $(f(u^-), f(u^+))_{f(z)}$ (which is the same up to
$O(\delta)$. And we do not take for $H$ a geodesic from $f(z)$ to its projection on $G$, but rather
a geodesic from $f(z)$ to the point $m$ on $[f(u^-), f(u^+)]$ opposite to $f(z)$ in the tripod, i.e.,
at distance $(f(z), f(u^+))_{f(u^-)}$ of $f(u^-)$, and at distance $(f(z), f(u^-))_{f(u^+)}$ of
$f(u^+)$. Let $\pi_z$ denote the point on $[f(z), m]$ at distance $(f(u^-), f(u^+)_{f(z)}$ of $f(z)$.
(It is within distance $2 \delta$ of $m$).
In both approaches, what we want to control by induction is the distance from $f(z)$ to $\pi_z$.
However, in the first approach, the points $f(u^-)$ and $f(u^+)$ project on $H$ between $\pi_z$ and
$f(z)$, and since the location of their projection is only controlled up to $4\delta$ one loses
essentially a $4\delta$-length of $L$ for the forthcoming argument. In the second approach, the
projections on $H$ are on the other side of $\pi_z$ compared to $f(z)$, so one does not lose
anything, and in the end it gives genuinely better bounds (making it possible to gain roughly
$10 \delta$ in the final estimate).
\end{itemize}
›

lemma (in Gromov_hyperbolic_space_geodesic) Morse_Gromov_theorem_aux1:
  fixes f::"real  'a"
  assumes "continuous_on {a..b} f"
          "lambda C-quasi_isometry_on {a..b} f"
          "a  b"
          "geodesic_segment_between G (f a) (f b)"
          "z  {a..b}"
          "delta > deltaG(TYPE('a))"
  shows "infdist (f z) G  lambda^2 * (11/2 * C + 91 * delta)"
proof -
  have "C  0" "lambda  1" using quasi_isometry_onD assms by auto
  have "delta > 0" using assms delta_nonneg order_trans by linarith

  text ‹We give their values to the parameters $L$, $D$ and $\alpha$ that we will use in the proof.
  We also define two constants $K$ and $K_{mult}$ that appear in the precise formulation of the
  bounds. Their values have no precise meaning, they are just the outcome of the computation›
  define alpha::real where "alpha = 12/100"
  have alphaaux:"alpha > 0" "alpha  1" unfolding alpha_def by auto
  define L::real where "L = 18 * delta"
  define D::real where "D = 55 * delta"
  define K where "K = alpha * ln 2 / (5 * (4 + (L + 2 * delta)/D) * delta * lambda)"
  have "K > 0" "L > 0" "D > 0" unfolding K_def L_def D_def using delta > 0 lambda  1 alpha_def by auto
  have Laux: "L  18 * delta" "D  50 * delta" "L  D" "D  4 * L" unfolding L_def D_def using delta > 0 by auto
  have Daux: "8 * delta  (1 - alpha) * D" unfolding alpha_def D_def using delta > 0 by auto
  define Kmult where "Kmult = ((L + 4 * delta)/(L - 13 * delta)) * ((4 * exp(1/2 * ln 2)) * lambda * exp (- (1 - alpha) * D * ln 2 / (5 * delta)) / K)"
  have "Kmult > 0" unfolding Kmult_def using Laux delta > 0 K > 0 lambda  1 by (auto simp add: divide_simps)

  text ‹We prove that, for any pair of points to the left and to the right of $f(z)$, the distance
  from $f(z)$ to a geodesic between these points is controlled. We prove this by reducing to a
  closer pair of points, i.e., this is an inductive argument over real numbers. However, we
  formalize it as an artificial induction over natural numbers, as this is how induction works
  best, and since in our reduction step the new pair of points is always significantly closer
  than the initial one, at least by an amount $\delta/\lambda$.

  The main inductive bound that we will prove is the following. In this bound, the first term is
  what comes from the trivial cases 1 and 2.1 in the description of the proof before the statement
  of the theorem, while the most interesting term is the second term, corresponding to the induction
  per se.›
  have Main: "um uM. um  {a..z}  uM  {z..b}
           uM - um  n * (1/4) * delta / lambda
           Gromov_product_at (f z) (f um) (f uM)  lambda^2 * (D + (3/2) * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (uM - um)))"
    for n::nat
  proof (induction n)
    text ‹Trivial base case of the induction›
    case 0
    then have *: "z = um" "z = uM" by auto
    then have "Gromov_product_at (f z) (f um) (f uM) = 0" by auto
    also have "...  1 * (D + (3/2) * L + delta + 11/2 * C) - 2 * delta + 0 * (1 - exp(- K * (uM - um)))"
      using Laux C  0 delta > 0 by auto
    also have "...  lambda^2 * (D + (3/2) * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (uM - um)))"
      apply (intro mono_intros)
      using C  0 delta > 0 Laux D > 0 K > 0 "0.prems" lambda  1 Kmult > 0 by auto
    finally show ?case by auto
  next
    case (Suc n)
    show ?case
    proof (cases "Gromov_product_at (f z) (f um) (f uM)  L")
      text ‹If $f(z)$ is already close to the geodesic, there is nothing to do, and we do not need
      the induction assumption. This is case 1 in the description above.›
      case True
      have "L  1 * (D + (3/2) * L + delta + 11/2 * C) - 2 * delta + 0 * (1 - exp(- K * (uM - um)))"
        using Laux C  0 delta > 0 by auto
      also have "...  lambda^2 * (D + (3/2) * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (uM - um)))"
        apply (intro mono_intros)
        using C  0 delta > 0 Laux D > 0 "Suc.prems" K > 0 lambda  1 Kmult > 0 by auto
      finally show ?thesis using True by auto
    next
      text ‹We come to the interesting case where $f(z)$ is far away from a geodesic between
      $f(um)$ and $f(uM)$. Let $m$ be close to a projection of $f(z)$ on such a geodesic (we use
      the opposite point of $f(z)$ on the corresponding tripod). On a geodesic between $f(z)$ and $m$,
      consider the point $pi_z$ at distance $(f(um), f(uM))_{f(z)}$ of $f(z)$. It is very close to
      $m$ (within distance $2 \delta$). We will push the points $f(um)$ and $f(uM)$
      towards $f(z)$ by considering points whose projection on a geodesic $H$ between $m$ and
      $z$ is roughly at distance $L$ of $pi_z$.›
      case False
      define m where "m = geodesic_segment_param {f um--f uM} (f um) (Gromov_product_at (f um) (f z) (f uM))"
      have "dist (f z) m  Gromov_product_at (f z) (f um) (f uM) + 2 * deltaG(TYPE('a))"
        unfolding m_def by (rule dist_triangle_side_middle, auto)
      then have *: "dist (f z) m  Gromov_product_at (f z) (f um) (f uM) + 2 * delta"
        using ‹deltaG(TYPE('a)) < delta by auto
      have "Gromov_product_at (f z) (f um) (f uM)  infdist (f z) {f um--f uM}"
        by (intro mono_intros, auto)
      also have "...  dist (f z) m"
        apply (rule infdist_le) unfolding m_def by auto
      finally have **: "Gromov_product_at (f z) (f um) (f uM)  dist (f z) m"
        by auto

      define H where "H = {f z--m}"
      define pi_z where "pi_z = geodesic_segment_param H (f z) (Gromov_product_at (f z) (f um) (f uM))"
      have "pi_z  H" "m  H" "f z  H"
        unfolding pi_z_def H_def by (auto simp add: geodesic_segment_param_in_segment)
      have H: "geodesic_segment_between H (f z) m"
        unfolding H_def by auto
      have Dpi_z: "dist (f z) pi_z = Gromov_product_at (f z) (f um) (f uM)"
        unfolding pi_z_def H_def by (rule geodesic_segment_param(6)[where ?y = m], auto simp add: **)
      moreover have "dist (f z) m = dist (f z) pi_z + dist pi_z m"
        apply (rule geodesic_segment_dist[of H, symmetric]) using pi_z  H unfolding H_def by auto
      ultimately have "dist pi_z m  2 * delta"
        using * by auto

      text ‹Introduce the notation $p$ for some projection on the geodesic $H$.›
      define p where "p = (λr. SOME x. x  proj_set (f r) H)"
      have p: "p x  proj_set (f x) H" for x
        unfolding p_def using proj_set_nonempty_of_proper[of H "f x"] geodesic_segment_topology[OF geodesic_segmentI[OF H]]
        by (simp add: some_in_eq)
      then have pH: "p x  H" for x
        using proj_setD(1) by auto
      have pz: "p z = f z"
        using p[of z] H by auto

      text ‹The projection of $f(um)$ on $H$ is close to $pi_z$ (but it does not have to be exactly
      $pi_z$). It is between $pi_z$ and $m$.›
      have "dist (f um) (f z)  dist (f um) (p um) + dist (p um) (f z)"
        by (intro mono_intros)
      also have "...  dist (f um) m + dist (p um) (f z)"
        unfolding proj_setD(2)[OF p[of um]] H_def by (auto intro!: infdist_le)
      also have "... = Gromov_product_at (f um) (f z) (f uM) + dist (p um) (f z)"
        unfolding m_def by simp
      finally have A: "Gromov_product_at (f z) (f um) (f uM)  dist (p um) (f z)"
        unfolding Gromov_product_at_def by (simp add: metric_space_class.dist_commute divide_simps)
      have "dist (p um) pi_z = abs(dist (p um) (f z) - dist pi_z (f z))"
        apply (rule dist_along_geodesic_wrt_endpoint[of H _ m]) using pH pi_z  H H_def by auto
      also have "... = dist (p um) (f z) - dist pi_z (f z)"
        using A Dpi_z by (simp add: metric_space_class.dist_commute)
      finally have Dum: "dist (p um) (f z) = dist (p um) pi_z + dist pi_z (f z)" by auto

      text ‹Choose a point $f(ym)$ whose projection on $H$ is roughly at distance $L$ of $pi_z$.›
      have "ym  {um..z}. (dist (p um) (p ym)  {(L + dist pi_z (p um)) - 4 * delta - 2 * 0 .. L + dist pi_z (p um)})
                     (r  {um..ym}. dist (p um) (p r)  L + dist pi_z (p um))"
      proof (rule quasi_convex_projection_small_gaps[where ?f = f and ?G = H])
        show "continuous_on {um..z} f"
          apply (rule continuous_on_subset[OF ‹continuous_on {a..b} f])
          using um  {a..z} z  {a..b} by auto
        show "um  z" using um  {a..z} by auto
        show "quasiconvex 0 H" using quasiconvex_of_geodesic geodesic_segmentI H by auto
        show "deltaG TYPE('a) < delta" by fact
        have "L + dist pi_z (p um)  dist (f z) pi_z + dist pi_z (p um)"
          using False Dpi_z by (simp add: metric_space_class.dist_commute)
        then have "L + dist pi_z (p um)  dist (p um) (f z)"
          using Dum by (simp add: metric_space_class.dist_commute)
        then show "L + dist pi_z (p um)  {4 * delta + 2 * 0..dist (p um) (p z)}"
          using delta > 0 False L_def pz by auto
        show "p ym  proj_set (f ym) H" for ym using p by simp
      qed
      then obtain ym where ym : "ym  {um..z}"
                                "dist (p um) (p ym)  {(L + dist pi_z (p um)) - 4 * delta - 2 * 0 .. L + dist pi_z (p um)}"
                                "r. r  {um..ym}  dist (p um) (p r)  L + dist pi_z (p um)"
        by blast
      have *: "continuous_on {um..ym} (λr. infdist (f r) H)"
        using continuous_on_infdist[OF continuous_on_subset[OF ‹continuous_on {a..b} f, of "{um..ym}"], of H]
        ym  {um..z} um  {a..z} z  {a..b} by auto
      text ‹Choose a point $cm$ between $f(um)$ and $f(ym)$ realizing the minimal distance to $H$.
      Call this distance $dm$.›
      have "closestm  {um..ym}. v  {um..ym}. infdist (f closestm) H  infdist (f v) H"
        apply (rule continuous_attains_inf) using ym(1) * by auto
      then obtain closestm where closestm: "closestm  {um..ym}" "v. v  {um..ym}  infdist (f closestm) H  infdist (f v) H"
        by auto
      define dm where "dm = infdist (f closestm) H"
      have [simp]: "dm  0" unfolding dm_def using infdist_nonneg by auto

      text ‹Same things but in the interval $[z, uM]$.›
      have I: "dist m (f uM) = dist (f um) (f uM) - dist (f um) m"
              "dist (f um) m = Gromov_product_at (f um) (f z) (f uM)"
        using geodesic_segment_dist[of "{f um--f uM}" "f um" "f uM" m] m_def by auto
      have "dist (f uM) (f z)  dist (f uM) (p uM) + dist (p uM) (f z)"
        by (intro mono_intros)
      also have "...  dist (f uM) m + dist (p uM) (f z)"
        unfolding proj_setD(2)[OF p[of uM]] H_def by (auto intro!: infdist_le)
      also have "... = Gromov_product_at (f uM) (f z) (f um) + dist (p uM) (f z)"
        using I unfolding Gromov_product_at_def by (simp add: divide_simps algebra_simps metric_space_class.dist_commute)
      finally have A: "Gromov_product_at (f z) (f um) (f uM)  dist (p uM) (f z)"
        unfolding Gromov_product_at_def by (simp add: metric_space_class.dist_commute divide_simps)
      have "dist (p uM) pi_z = abs(dist (p uM) (f z) - dist pi_z (f z))"
        apply (rule dist_along_geodesic_wrt_endpoint[of H _ m]) using pH pi_z  H H_def by auto
      also have "... = dist (p uM) (f z) - dist pi_z (f z)"
        using A Dpi_z by (simp add: metric_space_class.dist_commute)
      finally have DuM: "dist (p uM) (f z) = dist (p uM) pi_z + dist pi_z (f z)" by auto

      text ‹Choose a point $f(yM)$ whose projection on $H$ is roughly at distance $L$ of $pi_z$.›
      have "yM  {z..uM}. dist (p uM) (p yM)  {(L + dist pi_z (p uM)) - 4* delta - 2 * 0 .. L + dist pi_z (p uM)}
                     (r  {yM..uM}. dist (p uM) (p r)  L + dist pi_z (p uM))"
      proof (rule quasi_convex_projection_small_gaps'[where ?f = f and ?G = H])
        show "continuous_on {z..uM} f"
          apply (rule continuous_on_subset[OF ‹continuous_on {a..b} f])
          using uM  {z..b} z  {a..b} by auto
        show "z  uM" using uM  {z..b} by auto
        show "quasiconvex 0 H" using quasiconvex_of_geodesic geodesic_segmentI H by auto
        show "deltaG TYPE('a) < delta" by fact
        have "L + dist pi_z (p uM)  dist (f z) pi_z + dist pi_z (p uM)"
          using False Dpi_z by (simp add: metric_space_class.dist_commute)
        then have "L + dist pi_z (p uM)  dist (p uM) (f z)"
          using DuM by (simp add: metric_space_class.dist_commute)
        then show "L + dist pi_z (p uM)  {4 * delta + 2 * 0..dist (p z) (p uM)}"
          using delta > 0 False L_def pz by (auto simp add: metric_space_class.dist_commute)
        show "p yM  proj_set (f yM) H" for yM using p by simp
      qed
      then obtain yM where yM: "yM  {z..uM}"
                              "dist (p uM) (p yM)  {(L + dist pi_z (p uM)) - 4* delta - 2 * 0 .. L + dist pi_z (p uM)}"
                              "r. r  {yM..uM}  dist (p uM) (p r)  L + dist pi_z (p uM)"
        by blast
      have *: "continuous_on {yM..uM} (λr. infdist (f r) H)"
        using continuous_on_infdist[OF continuous_on_subset[OF ‹continuous_on {a..b} f, of "{yM..uM}"], of H]
        yM  {z..uM} uM  {z..b} z  {a..b} by auto
      have "closestM  {yM..uM}. v  {yM..uM}. infdist (f closestM) H  infdist (f v) H"
        apply (rule continuous_attains_inf) using yM(1) * by auto
      then obtain closestM where closestM: "closestM  {yM..uM}" "v. v  {yM..uM}  infdist (f closestM) H  infdist (f v) H"
        by auto
      define dM where "dM = infdist (f closestM) H"
      have [simp]: "dM  0" unfolding dM_def using infdist_nonneg by auto

      text ‹Points between $f(um)$ and $f(ym)$, or between $f(yM)$ and $f(uM)$, project within
      distance at most $L$ of $pi_z$ by construction.›
      have P0: "dist m (p x)  dist m pi_z + L" if "x  {um..ym}  {yM..uM}" for x
      proof (cases "x  {um..ym}")
        case True
        have "dist m (f z) = dist m (p um) + dist (p um) pi_z + dist pi_z (f z)"
          using geodesic_segment_dist[OF H pH[of um]] Dum by (simp add: metric_space_class.dist_commute)
        moreover have "dist m (f z) = dist m pi_z + dist pi_z (f z)"
          using geodesic_segment_dist[OF H pi_z  H] by (simp add: metric_space_class.dist_commute)
        ultimately have *: "dist m pi_z = dist m (p um) + dist (p um) pi_z" by auto
        have "dist (p um) (p x)  L + dist pi_z (p um)"
          using ym(3)[OF x  {um..ym}] by blast
        then show ?thesis
          using metric_space_class.dist_triangle[of m "p x" "p um"] * by (auto simp add: metric_space_class.dist_commute)
      next
        case False
        then have "x  {yM..uM}" using that by auto
        have "dist m (f z) = dist m (p uM) + dist (p uM) pi_z + dist pi_z (f z)"
          using geodesic_segment_dist[OF H pH[of uM]] DuM by (simp add: metric_space_class.dist_commute)
        moreover have "dist m (f z) = dist m pi_z + dist pi_z (f z)"
          using geodesic_segment_dist[OF H pi_z  H] by (simp add: metric_space_class.dist_commute)
        ultimately have *: "dist m pi_z = dist m (p uM) + dist (p uM) pi_z" by auto
        have "dist (p uM) (p x)  L + dist pi_z (p uM)"
          using yM(3)[OF x  {yM..uM}] by blast
        then show ?thesis
          using metric_space_class.dist_triangle[of m "p x" "p uM"] * by (auto simp add: metric_space_class.dist_commute)
      qed
      have P: "dist pi_z (p x)  L" if "x  {um..ym}  {yM..uM}" for x
      proof (cases "dist m (p x)  dist pi_z m")
        case True
        have "dist pi_z (p x)  dist pi_z m + dist m (p x)"
          by (intro mono_intros)
        also have "...  2 * delta + 2 * delta"
          using ‹dist pi_z m  2 * delta True by auto
        finally show ?thesis
          using Laux delta > 0 by auto
      next
        case False
        have "dist pi_z (p x) = abs(dist pi_z m - dist (p x) m)"
          apply (rule dist_along_geodesic_wrt_endpoint[OF geodesic_segment_commute[OF H]])
          using pH pi_z  H by auto
        also have "... = dist (p x) m - dist pi_z m"
          using False by (simp add: metric_space_class.dist_commute)
        finally show ?thesis
          using P0[OF that] by (simp add: metric_space_class.dist_commute)
      qed
      text ‹Auxiliary fact for later use:
      The distance between two points in $[um, ym]$ and $[yM, uM]$ can be controlled using
      the distances of their images under $f$ to $H$, thanks to the quasi-isometry property.›
      have D: "dist rm rM  lambda * (infdist (f rm) H + (L + C + 2 * delta) + infdist (f rM) H)"
        if "rm  {um..ym}" "rM  {yM..uM}" for rm rM
      proof -
        have *: "dist m (p rm)  L + dist m pi_z" "dist m (p rM)  L + dist m pi_z"
          using P0 that by force+
        have "dist (p rm) (p rM) = abs(dist (p rm) m - dist (p rM) m)"
          apply (rule dist_along_geodesic_wrt_endpoint[OF geodesic_segment_commute[OF H]])
          using pH by auto
        also have "...  L + dist m pi_z"
          unfolding abs_le_iff using * apply (auto simp add: metric_space_class.dist_commute)
          by (metis diff_add_cancel le_add_same_cancel1 metric_space_class.zero_le_dist order_trans)+
        finally have *: "dist (p rm) (p rM)  L + 2 * delta"
          using ‹dist pi_z m  2 * delta by (simp add: metric_space_class.dist_commute)

        have "(1/lambda) * dist rm rM - C  dist (f rm) (f rM)"
          apply (rule quasi_isometry_onD(2)[OF lambda C-quasi_isometry_on {a..b} f])
          using rm  {um..ym} ym  {um..z} um  {a..z} z  {a..b} rM  {yM..uM} yM  {z..uM} uM  {z..b} by auto
        also have "...  dist (f rm) (p rm) + dist (p rm) (p rM) + dist (p rM) (f rM)"
          by (intro mono_intros)
        also have "...  infdist (f rm) H + L + 2 * delta + infdist (f rM) H"
          using * proj_setD(2)[OF p] by (simp add: metric_space_class.dist_commute)
        finally show ?thesis
          using lambda  1 by (simp add: algebra_simps divide_simps)
      qed
      text ‹Auxiliary fact for later use in the inductive argument:
      the distance from $f(z)$ to $pi_z$ is controlled by the distance from $f(z)$ to any
      intermediate geodesic between points in $f[um, ym]$ and $f[yM, uM]$, up to a constant
      essentially given by $L$. This is a variation around Lemma 5 in~\cite{shchur}.›
      have Rec: "Gromov_product_at (f z) (f um) (f uM)  Gromov_product_at (f z) (f rm) (f rM) + (L + 4 * delta)" if "rm  {um..ym}" "rM  {yM..uM}" for rm rM
      proof -
        have *: "dist (f rm) (p rm) + dist (p rm) (f z)  dist (f rm) (f z) + 4 * deltaG(TYPE('a))"
          apply (rule dist_along_geodesic[of H]) using p H_def by auto
        have "dist (f z) pi_z  dist (f z) (p rm) + dist (p rm) pi_z"
          by (intro mono_intros)
        also have "...  (Gromov_product_at (f z) (f rm) (p rm) + 2 * deltaG(TYPE('a))) + L"
          apply (intro mono_intros) using * P rm  {um..ym} unfolding Gromov_product_at_def
          by (auto simp add: metric_space_class.dist_commute algebra_simps divide_simps)
        finally have A: "dist (f z) pi_z - L - 2 * deltaG(TYPE('a))  Gromov_product_at (f z) (f rm) (p rm)"
          by simp
        have *: "dist (f rM) (p rM) + dist (p rM) (f z)  dist (f rM) (f z) + 4 * deltaG(TYPE('a))"
          apply (rule dist_along_geodesic[of H]) using p H_def by auto
        have "dist (f z) pi_z  dist (f z) (p rM) + dist (p rM) pi_z"
          by (intro mono_intros)
        also have "...  (Gromov_product_at (f z) (p rM) (f rM) + 2 * deltaG(TYPE('a))) + L"
          apply (intro mono_intros) using * P rM  {yM..uM} unfolding Gromov_product_at_def
          by (auto simp add: metric_space_class.dist_commute algebra_simps divide_simps)
        finally have B: "dist (f z) pi_z - L - 2 * deltaG(TYPE('a))  Gromov_product_at (f z) (p rM) (f rM)"
          by simp
        have C: "dist (f z) pi_z - L - 2 * deltaG(TYPE('a))  Gromov_product_at (f z) (p rm) (p rM)"
        proof (cases "dist (f z) (p rm)  dist (f z) (p rM)")
          case True
          have "dist (p rm) (p rM) = abs(dist (f z) (p rm) - dist (f z) (p rM))"
            using proj_setD(1)[OF p] dist_along_geodesic_wrt_endpoint[OF H, of "p rm" "p rM"]
            by (simp add: metric_space_class.dist_commute)
          also have "... = dist (f z) (p rM) - dist (f z) (p rm)"
            using True by auto
          finally have *: "dist (f z) (p rm) = Gromov_product_at (f z) (p rm) (p rM)"
            unfolding Gromov_product_at_def by auto
          have "dist (f z) pi_z  dist (f z) (p rm) + dist (p rm) pi_z"
            by (intro mono_intros)
          also have "...  Gromov_product_at (f z) (p rm) (p rM) + L + 2 * deltaG(TYPE('a))"
            using * P[of rm] rm  {um..ym} apply (simp add: metric_space_class.dist_commute)
            using local.delta_nonneg by linarith
          finally show ?thesis by simp
        next
          case False
          have "dist (p rm) (p rM) = abs(dist (f z) (p rm) - dist (f z) (p rM))"
            using proj_setD(1)[OF p] dist_along_geodesic_wrt_endpoint[OF H, of "p rm" "p rM"]
            by (simp add: metric_space_class.dist_commute)
          also have "... = dist (f z) (p rm) - dist (f z) (p rM)"
            using False by auto
          finally have *: "dist (f z) (p rM) = Gromov_product_at (f z) (p rm) (p rM)"
            unfolding Gromov_product_at_def by auto
          have "dist (f z) pi_z  dist (f z) (p rM) + dist (p rM) pi_z"
            by (intro mono_intros)
          also have "...  Gromov_product_at (f z) (p rm) (p rM) + L + 2 * deltaG(TYPE('a))"
            using * P[of rM] rM  {yM..uM} apply (simp add: metric_space_class.dist_commute)
            using local.delta_nonneg by linarith
          finally show ?thesis by simp
        qed

        have "Gromov_product_at (f z) (f um) (f uM) - L - 2 * deltaG(TYPE('a))  Min {Gromov_product_at (f z) (f rm) (p rm), Gromov_product_at (f z) (p rm) (p rM), Gromov_product_at (f z) (p rM) (f rM)}"
          using A B C unfolding Dpi_z by auto
        also have "...  Gromov_product_at (f z) (f rm) (f rM) + 2 * deltaG(TYPE('a))"
          by (intro mono_intros)
        finally show ?thesis
          using ‹deltaG(TYPE('a)) < delta by auto
      qed

      text ‹We have proved the basic facts we will need in the main argument. This argument starts
      here. It is divided in several cases.›
      consider "dm  D + 4 * C  dM  D + 4 * C" | "dm  D + 4 * C  dM  dm" | "dM  D + 4 * C  dm  dM"
        by linarith
      then show ?thesis
      proof (cases)
        text ‹Case 2.1 of the description before the statement: there are points in $f[um, ym]$ and
        in $f[yM, uM]$ which are close to $H$. Then one can conclude directly, without relying
        on the inductive argument, thanks to the quasi-isometry property.›
        case 1
        have I: "Gromov_product_at (f z) (f closestm) (f closestM)  lambda^2 * (D + L / 2 + delta + 11/2 * C) - 6 * delta"
        proof (cases "dist (f closestm) (f closestM)  12 * delta")
          case True
          have "1/lambda * dist closestm closestM - C  dist (f closestm) (f closestM)"
            using quasi_isometry_onD(2)[OF assms(2)] closestm  {um..ym} um  {a..z} z  {a..b} ym  {um..z}
            closestM  {yM..uM} uM  {z..b} z  {a..b} yM  {z..uM} by auto
          then have "dist closestm closestM  lambda * dist (f closestm) (f closestM) + lambda * C"
            using lambda  1 by (auto simp add: divide_simps algebra_simps)
          also have "...  lambda * (12 * delta) + lambda * C"
            apply (intro mono_intros True) using lambda  1 by auto
          finally have M: "dist closestm closestM  lambda * (12 * delta + C)"
            by (auto simp add: algebra_simps)

          have "2 * Gromov_product_at (f z) (f closestm) (f closestM)  dist (f closestm) (f z) + dist (f z) (f (closestM))"
            unfolding Gromov_product_at_def by (auto simp add: metric_space_class.dist_commute)
          also have "...  (lambda * dist closestm z + C) + (lambda * dist z closestM + C)"
            apply (intro mono_intros quasi_isometry_onD(1)[OF assms(2)])
            using closestm  {um..ym} um  {a..z} z  {a..b} ym  {um..z}
            closestM  {yM..uM} uM  {z..b} z  {a..b} yM  {z..uM} by auto
          also have "... = lambda * dist closestm closestM + 1 * 2 * C"
            unfolding dist_real_def using closestm  {um..ym} um  {a..z} z  {a..b} ym  {um..z}
            closestM  {yM..uM} uM  {z..b} z  {a..b} yM  {z..uM} by (auto simp add: algebra_simps)
          also have "...  lambda * (lambda * (12 * delta + C)) + lambda^2 * 2 * C"
            apply (intro mono_intros M) using lambda  1 C  0 by auto
          also have "... = lambda^2 * (24 * delta + 3 * C) - lambda^2 * 12 * delta"
            by (simp add: algebra_simps power2_eq_square)
          also have "...  lambda^2 * ((2 * D + L + 2 * delta) + 11 * C) - 1 * 12 * delta"
            apply (intro mono_intros) using Laux lambda  1 C  0 delta > 0 by auto
          finally show ?thesis
            by (auto simp add: divide_simps algebra_simps)
        next
          case False
          have "dist closestm closestM  lambda * (dm + dM + L + 2 * delta + C)"
            using D[OF closestm  {um..ym} closestM  {yM..uM}] dm_def dM_def by (auto simp add: algebra_simps)
          also have "...  lambda * ((D + 4 * C) + (D + 4 * C) + L + 2 * delta + C)"
            apply (intro mono_intros) using 1 lambda  1 by auto
          also have "...  lambda * (2 * D + L + 2 * delta + 9 * C)"
            using lambda  1 C  0 by auto
          finally have M: "dist closestm closestM  lambda * (2 * D + L + 2 * delta + 9 * C)"
            by (auto simp add: algebra_simps divide_simps metric_space_class.dist_commute)

          have "dist (f closestm) (f z) + dist (f z) (f (closestM))  (lambda * dist closestm z + C) + (lambda * dist z closestM + C)"
            apply (intro mono_intros quasi_isometry_onD(1)[OF assms(2)])
            using closestm  {um..ym} um  {a..z} z  {a..b} ym  {um..z}
            closestM  {yM..uM} uM  {z..b} z  {a..b} yM  {z..uM} by auto
          also have "... = lambda * dist closestm closestM + 1 * 2 * C"
            unfolding dist_real_def using closestm  {um..ym} um  {a..z} z  {a..b} ym  {um..z}
            closestM  {yM..uM} uM  {z..b} z  {a..b} yM  {z..uM} by (auto simp add: algebra_simps)
          also have "...  lambda * (lambda * (2 * D + L + 2 * delta + 9 * C)) + lambda^2 * 2 * C"
            apply (intro mono_intros M) using lambda  1 C  0 by auto
          finally have "dist (f closestm) (f z) + dist (f z) (f closestM)  lambda^2 * (2 * D + L + 2 * delta + 11 * C)"
            by (simp add: algebra_simps power2_eq_square)
          then show ?thesis
            unfolding Gromov_product_at_def using False by (simp add: metric_space_class.dist_commute algebra_simps divide_simps)
        qed
        have "Gromov_product_at (f z) (f um) (f uM)  Gromov_product_at (f z) (f closestm) (f closestM) + 1 * L + 4 * delta + 0 * (1 - exp (- K * (uM - um)))"
          using Rec[OF closestm  {um..ym} closestM  {yM..uM}] by simp
        also have "...  (lambda^2 * (D + L / 2 + delta + 11/2 * C) - 6 * delta) + lambda^2 * L + 4 * delta + Kmult * (1 - exp (- K * (uM - um)))"
          apply (intro mono_intros I)
          using Laux lambda  1 delta > 0 Kmult > 0 um  {a..z} uM  {z..b} K > 0 by auto
        finally show ?thesis
          by (simp add: algebra_simps)
        text ‹End of the easy case 2.1›
      next
        text ‹Case 2.2: $dm$ is large, i.e., all points in $f[um, ym]$ are far away from $H$. Moreover,
        assume that $dm \geq dM$. Then we will find a pair of points $v$ and $x$ with $um \leq v
        \leq x \leq ym$ satisfying the estimate~\eqref{eq:xvK}. We argue by induction: while we
        have not found such a pair, we can find a point $x_k$ whose projection on $V_k$, the
        neighborhood of size $(2^k-1) dm$ of $H$, is far enough from the projection of $um$, and
        such that all points in between are far enough from $V_k$ so that the corresponding
        projection will have good contraction properties.›
        case 2
        then have I: "D + 4 * C  dm" "dM  dm" by auto
        define V where "V = (λk::nat. (gH. cball g ((2^k - 1) * dm)))"
        define QC where "QC = (λk::nat. if k = 0 then 0 else 8 * delta)"
        have "QC k  0" for k unfolding QC_def using delta > 0 by auto
        have Q: "quasiconvex (0 + 8 * deltaG(TYPE('a))) (V k)" for k
          unfolding V_def apply (rule quasiconvex_thickening) using geodesic_segmentI[OF H]
          by (auto simp add: quasiconvex_of_geodesic)
        have "quasiconvex (QC k) (V k)" for k
          apply (cases "k = 0")
          apply (simp add: V_def QC_def quasiconvex_of_geodesic geodesic_segmentI[OF H])
          apply (rule quasiconvex_mono[OF _ Q[of k]]) using ‹deltaG(TYPE('a)) < delta QC_def by auto
        text ‹Define $q(k, x)$ to be the projection of $f(x)$ on $V_k$.›
        define q::"nat  real  'a" where "q = (λk x. geodesic_segment_param {p x--f x} (p x) ((2^k - 1) * dm))"

        text ‹The inductive argument›
        have Ind_k: "(Gromov_product_at (f z) (f um) (f uM)  lambda^2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (uM - um))))
               (x  {um..ym}. (w  {um..x}. dist (f w) (p w)  (2^(k+1)-1) * dm)  dist (q k um) (q k x)  L - 4 * delta + 7 * QC k)" for k
        proof (induction k)
          text ‹Base case: there is a point far enough from $q 0 um$ on $H$. This is just the point $ym$,
          by construction.›
          case 0
          have *: "x {um..ym}. (w  {um..x}. dist (f w) (p w)  (2^(0+1)-1) * dm)  dist (q 0 um) (q 0 x)  L - 4 * delta + 7 * QC 0"
          proof (rule bexI[of _ ym], auto simp add: V_def q_def QC_def)
            show "um  ym" using ym  {um..z} by auto
            show "L - 4 * delta  dist (p um) (p ym)"
              using ym(2) apply auto using metric_space_class.zero_le_dist[of pi_z "p um"] by linarith
            show "y. um  y  y  ym  dm  dist (f y) (p y)"
              using dm_def closestm proj_setD(2)[OF p] by auto
          qed
          then show ?case
            by blast
        next
          text ‹The induction. The inductive assumption claims that, either the desired inequality
          holds, or one can construct a point with good properties. If the desired inequality holds,
          there is nothing left to prove. Otherwise, we can start from this point at step $k$,
          say $x$, and either prove the desired inequality or construct a point with the good
          properties at step $k+1$.›
          case Suck: (Suc k)
          show ?case
          proof (cases "Gromov_product_at (f z) (f um) (f uM)  lambda2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp (- K * (uM - um)))")
            case True
            then show ?thesis by simp
          next
            case False
            then obtain x where x: "x  {um..ym}" "dist (q k um) (q k x)  L - 4 * delta + 7 * QC k"
                                   "w. w  {um..x}  dist (f w) (p w)  (2^(k+1)-1) * dm"
              using Suck.IH by auto

            text ‹Some auxiliary technical inequalities to be used later on.›
            have aux: "(2 ^ k - 1) * dm  (2*2^k-1) * dm" "0  2 * 2 ^ k - (1::real)" "dm  dm * 2 ^ k"
              apply (auto simp add: algebra_simps)
              apply (metis power.simps(2) two_realpow_ge_one)
              using 0  dm less_eq_real_def by fastforce
            have "L + C = (L/D) * (D + (D/L) * C)"
              using L > 0 D > 0 by (simp add: algebra_simps divide_simps)
            also have "...  (L/D) * (D + 4 * C)"
              apply (intro mono_intros)
              using L > 0 D > 0 C  0 D  4 * L by (auto simp add: algebra_simps divide_simps)
            also have "...  (L/D) * dm"
              apply (intro mono_intros) using I L > 0 D > 0 by auto
            finally have "L + C  (L/D) * dm"
              by simp
            moreover have "2 * delta  (2 * delta)/D * dm"
              using I C  0 delta > 0 D > 0 by (auto simp add: algebra_simps divide_simps)
            ultimately have aux2: "L + C + 2 * delta  ((L + 2 * delta)/D) * dm"
              by (auto simp add: algebra_simps divide_simps)
            have aux3: "(1-alpha) * D + alpha * 2^k * dm  dm * 2^k - C/2 - QC k"
            proof (cases "k = 0")
              case True
              show ?thesis
                 using I C  0 unfolding True QC_def alpha_def by auto
            next
              case False
              have "C/2 + QC k + (1-alpha) * D  2 * (1-alpha) * dm"
                using I C  0 unfolding QC_def alpha_def using False Laux by auto
              also have "...  2^k * (1-alpha) * dm"
                apply (intro mono_intros) using False alphaaux I D > 0 C  0 by auto
              finally show ?thesis
                by (simp add: algebra_simps)
            qed

            text ‹Construct a point $w$ such that its projection on $V_k$ is close to that of $um$
            and therefore far away from that of $x$. This is just the intermediate value theorem
            (with some care as the closest point projection is not continuous).›
            have "w  {um..x}. (dist (q k um) (q k w)  {(9 * delta + 4 * QC k) - 4 * delta - 2 * QC k .. 9 * delta + 4 * QC k})
                     (v  {um..w}. dist (q k um) (q k v)  9 * delta + 4 * QC k)"
            proof (rule quasi_convex_projection_small_gaps[where ?f = f and ?G = "V k"])
              show "continuous_on {um..x} f"
                apply (rule continuous_on_subset[OF ‹continuous_on {a..b} f])
                using um  {a..z} z  {a..b} ym  {um..z} x  {um..ym} by auto
              show "um  x" using x  {um..ym} by auto
              show "quasiconvex (QC k) (V k)" by fact
              show "deltaG TYPE('a) < delta" by fact
              show "9 * delta + 4 * QC k  {4 * delta + 2 * QC k..dist (q k um) (q k x)}"
                using x(2) delta > 0 QC k  0 Laux by auto
              show "q k w  proj_set (f w) (V k)" if "w  {um..x}" for w
                unfolding V_def q_def apply (rule proj_set_thickening)
                using aux p x(3)[OF that] by (auto simp add: metric_space_class.dist_commute)
            qed
            then obtain w where w: "w  {um..x}"
                                   "dist (q k um) (q k w)  {(9 * delta + 4 * QC k) - 4 * delta - 2 * QC k .. 9 * delta + 4 * QC k}"
                                   "v. v  {um..w}  dist (q k um) (q k v)  9 * delta + 4 * QC k"
              by auto
            text ‹There are now two cases to be considered: either one can find a point $v$ between
            $um$ and $w$ which is close enough to $H$. Then this point will satisfy~\eqref{eq:xvK},
            and we will be able to prove the desired inequality. Or there is no such point,
            and then $w$ will have the good properties at step $k+1$›
            show ?thesis
            proof (cases "v  {um..w}. dist (f v) (p v)  (2^(k+2)-1) * dm")
              case True
              text ‹First subcase: there is a good point $v$ between $um$ and $w$. This is the
              heart of the argument: we will show that the desired inequality holds.›
              then obtain v where v: "v  {um..w}" "dist (f v) (p v)  (2^(k+2)-1) * dm"
                by auto
              text ‹Auxiliary basic fact to be used later on.›
              have aux4: "dm * 2 ^ k  infdist (f r) (V k)" if "r  {v..x}" for r
              proof -
                have *: "q k r  proj_set (f r) (V k)"
                  unfolding q_def V_def apply (rule proj_set_thickening)
                  using aux p[of r] x(3)[of r] that v  {um..w} w  {um..x} by (auto simp add: metric_space_class.dist_commute)
                have "infdist (f r) (V k) = dist (geodesic_segment_param {p r--f r} (p r) (dist (p r) (f r))) (geodesic_segment_param {p r--f r} (p r) ((2 ^ k - 1) * dm))"
                  using proj_setD(2)[OF *] unfolding q_def by auto
                also have "... = abs(dist (p r) (f r) - (2 ^ k - 1) * dm)"
                  apply (rule geodesic_segment_param(7)[where ?y = "f r"])
                  using x(3)[of r] r  {v..x} v  {um..w} w  {um..x} aux by (auto simp add: metric_space_class.dist_commute)
                also have "... = dist (f r) (p r) - (2 ^ k - 1) * dm"
                  using x(3)[of r] r  {v..x} v  {um..w} w  {um..x} aux by (auto simp add: metric_space_class.dist_commute)
                finally have "dist (f r) (p r) = infdist (f r) (V k) + (2 ^ k - 1) * dm" by simp
                moreover have "(2^(k+1) - 1) * dm  dist (f r) (p r)"
                  apply (rule x(3)) using r  {v..x} v  {um..w} w  {um..x} by auto
                ultimately have "(2^(k+1) - 1) * dm  infdist (f r) (V k) + (2 ^ k - 1) * dm"
                  by simp
                then show ?thesis by (auto simp add: algebra_simps)
              qed

              text ‹Substep 1: We can control the distance from $f(v)$ to $f(closestM)$ in terms of the distance
              of the distance of $f(v)$ to $H$, i.e., by $2^k dm$. The same control follows
              for $closestM - v$ thanks to the quasi-isometry property. Then, we massage this
              inequality to put it in the form we will need, as an upper bound on $(x-v) \exp(-2^k dm)$.›
              have "infdist (f v) H  (2^(k+2)-1) * dm"
                using v proj_setD(2)[OF p[of v]] by auto
              have "dist v closestM  lambda * (infdist (f v) H + (L + C + 2 * delta) + infdist (f closestM) H)"
                apply (rule D)
                using v  {um..w} w  {um..x} x  {um..ym} ym  {um..z} um  {a..z} z  {a..b} closestM  {yM..uM} yM  {z..uM} uM  {z..b} by auto
              also have "...  lambda * ((2^(k+2)-1) * dm + 1 * (L + C + 2 * delta) + dM)"
                apply (intro mono_intros ‹infdist (f v) H  (2^(k+2)-1) * dm)
                using dM_def lambda  1 L > 0 C  0 delta > 0 by (auto simp add: metric_space_class.dist_commute)
              also have "...  lambda * ((2^(k+2)-1) * dm + 2^k * (((L + 2 * delta)/D) * dm) + dm)"
                apply (intro mono_intros) using I lambda  1 C  0 delta > 0 L > 0 aux2 by auto
              also have "... = lambda * 2^k * (4 + (L + 2 * delta)/D) * dm"
                by (simp add: algebra_simps)
              finally have *: "dist v closestM / (lambda * (4 + (L + 2 * delta)/D))  2^k * dm"
                using lambda  1 L > 0 D > 0 delta > 0 by (simp add: divide_simps, simp add: algebra_simps)
              text ‹We reformulate this control inside of an exponential, as this is the form we
              will use later on.›
              have "exp(- (alpha * (2^k * dm) * ln 2 / (5 * delta)))  exp(-(alpha * (dist v closestM / (lambda * (4 + (L + 2 * delta)/D))) * ln 2 / (5 * delta)))"
                apply (intro mono_intros *) using alphaaux delta > 0 by auto
              also have "... = exp(-K * dist v closestM)"
                unfolding K_def by (simp add: divide_simps)
              also have "... = exp(-K * (closestM - v))"
                unfolding dist_real_def using v  {um..w} w  {um..x} x  {um..ym} ym  {um..z} yM  {z..uM} closestM  {yM..uM} K > 0 by auto
              finally have "exp(- (alpha * (2^k * dm) * ln 2 / (5 * delta)))  exp(-K * (closestM - v))"
                by simp
              text ‹Plug in $x-v$ to get the final form of this inequality.›
              then have "K * (x - v) * exp(- (alpha * (2^k * dm) * ln 2 / (5 * delta)))  K * (x - v) * exp(-K * (closestM - v))"
                apply (rule mult_left_mono)
                using delta > 0 lambda  1 v  {um..w} w  {um..x} K > 0 by auto
              also have "... = ((1 + K * (x - v)) - 1) * exp(- K * (closestM - v))"
                by (auto simp add: algebra_simps)
              also have "...  (exp (K * (x - v)) - 1) * exp(-K * (closestM - v))"
                by (intro mono_intros, auto)
              also have "... = exp(-K * (closestM - x)) - exp(-K * (closestM - v))"
                by (simp add: algebra_simps mult_exp_exp)
              also have "...  exp(-K * (closestM - x)) - exp(-K * (uM - um))"
                using K > 0 v  {um..w} w  {um..x} x  {um..ym} ym  {um..z} yM  {z..uM} closestM  {yM..uM} by auto
              finally have B: "(x - v) * exp(- alpha * 2^k * dm * ln 2 / (5 * delta)) 
                                  (exp(-K * (closestM - x)) - exp(-K * (uM-um)))/K"
                using K > 0 by (auto simp add: divide_simps algebra_simps)
              text ‹End of substep 1›

              text ‹Substep 2: The projections of $f(v)$ and $f(x)$ on the cylinder $V_k$ are well separated,
              by construction. This implies that $v$ and $x$ themselves are well separated, thanks
              to the exponential contraction property of the projection on the quasi-convex set $V_k$.
              This leads to a uniform lower bound for $(x-v) \exp(-2^k dm)$, which has been upper bounded
              in Substep 1.›
              have "L - 4 * delta + 7 * QC k  dist (q k um) (q k x)"
                using x by simp
              also have "...  dist (q k um) (q k v) + dist (q k v) (q k x)"
                by (intro mono_intros)
              also have "...  (9 * delta + 4 * QC k) + dist (q k v) (q k x)"
                using w(3)[of v] v  {um..w} by auto
              finally have "L - 13 * delta + 3 * QC k  dist (q k v) (q k x)"
                by simp
              also have "...  3 * QC k + max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (x - v) * exp(-(dm * 2^k - C/2 - QC k) * ln 2 / (5 * delta)))"
              proof (cases "k = 0")
                text ‹We use different statements for the projection in the case $k = 0$ (projection on
                a geodesic) and $k > 0$ (projection on a quasi-convex set) as the bounds are better in
                the first case, which is the most important one for the final value of the constant.›
                case True
                have "dist (q k v) (q k x)  max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (x - v) * exp(-(dm * 2^k - C/2) * ln 2 / (5 * delta)))"
                proof (rule geodesic_projection_exp_contracting[where ?G = "V k" and ?f = f])
                  show "geodesic_segment (V k)" unfolding True V_def using geodesic_segmentI[OF H] by auto
                  show "v  x" using v  {um..w} w  {um..x} by auto
                  show "q k v  proj_set (f v) (V k)"
                    unfolding q_def V_def apply (rule proj_set_thickening)
                    using aux p[of v] x(3)[of v] v  {um..w} w  {um..x} by (auto simp add: metric_space_class.dist_commute)
                  show "q k x  proj_set (f x) (V k)"
                    unfolding q_def V_def apply (rule proj_set_thickening)
                    using aux p[of x] x(3)[of x] w  {um..x} by (auto simp add: metric_space_class.dist_commute)
                  show "15/2 * delta + C/2  dm * 2^k"
                    apply (rule order_trans[of _ dm])
                    using I delta > 0 C  0 Laux unfolding QC_def by auto
                  show "deltaG TYPE('a) < delta" by fact
                  show "t. t  {v..x}  dm * 2 ^ k  infdist (f t) (V k)"
                    using aux4 by auto
                  show "0  C" "0  lambda" using C  0 lambda  1 by auto
                  show "dist (f x1) (f x2)  lambda * dist x1 x2 + C" if "x1  {v..x}" "x2  {v..x}" for x1 x2
                    using quasi_isometry_onD(1)[OF assms(2)] that v  {um..w} w  {um..x} x  {um..ym} ym  {um..z} um  {a..z} z  {a..b} by auto
                qed
                then show ?thesis unfolding QC_def True by auto
              next
                case False
                have "dist (q k v) (q k x)  2 * QC k + 8 * delta + max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (x - v) * exp(-(dm * 2^k - QC k -C/2) * ln 2 / (5 * delta)))"
                proof (rule quasiconvex_projection_exp_contracting[where ?G = "V k" and ?f = f])
                  show "quasiconvex (QC k) (V k)" by fact
                  show "v  x" using v  {um..w} w  {um..x} by auto
                  show "q k v  proj_set (f v) (V k)"
                    unfolding q_def V_def apply (rule proj_set_thickening)
                    using aux p[of v] x(3)[of v] v  {um..w} w  {um..x} by (auto simp add: metric_space_class.dist_commute)
                  show "q k x  proj_set (f x) (V k)"
                    unfolding q_def V_def apply (rule proj_set_thickening)
                    using aux p[of x] x(3)[of x] w  {um..x} by (auto simp add: metric_space_class.dist_commute)
                  show "15/2 * delta + QC k + C/2  dm * 2^k"
                    apply (rule order_trans[of _ dm])
                    using I delta > 0 C  0 Laux unfolding QC_def by auto
                  show "deltaG TYPE('a) < delta" by fact
                  show "t. t  {v..x}  dm * 2 ^ k  infdist (f t) (V k)"
                    using aux4 by auto
                  show "0  C" "0  lambda" using C  0 lambda  1 by auto
                  show "dist (f x1) (f x2)  lambda * dist x1 x2 + C" if "x1  {v..x}" "x2  {v..x}" for x1 x2
                    using quasi_isometry_onD(1)[OF assms(2)] that v  {um..w} w  {um..x} x  {um..ym} ym  {um..z} um  {a..z} z  {a..b} by auto
                qed
                then show ?thesis unfolding QC_def using False by (auto simp add: algebra_simps)
              qed
              finally have "L - 13 * delta  max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (x - v) * exp(-(dm * 2^k - C/2 - QC k) * ln 2 / (5 * delta)))"
                by auto
              then have "L - 13 * delta  (4 * exp(1/2 * ln 2)) * lambda * (x - v) * exp(-(dm * 2^k - C/2 - QC k) * ln 2 / (5 * delta))"
                using delta > deltaG(TYPE('a)) Laux by auto
              text ‹We separate the exponential gain coming from the contraction into two parts, one
              to be spent to improve the constant, and one for the inductive argument.›
              also have "...  (4 * exp(1/2 * ln 2)) * lambda * (x - v) * exp(-((1-alpha) * D + alpha * 2^k * dm) * ln 2 / (5 * delta))"
                apply (intro mono_intros) using aux3 delta > 0 lambda  1 v  {um..w} w  {um..x} by auto
              also have "... = (4 * exp(1/2 * ln 2)) * lambda * (x - v) * (exp(-(1-alpha) * D * ln 2 / (5 * delta)) * exp(-alpha * 2^k * dm * ln 2 / (5 * delta)))"
                unfolding mult_exp_exp by (auto simp add: algebra_simps divide_simps)
              finally have A: "L - 13 * delta  (4 * exp(1/2 * ln 2)) * lambda * exp(-(1-alpha) * D * ln 2 / (5 * delta)) * ((x - v) * exp(-alpha * 2^k * dm * ln 2 / (5 * delta)))"
                by (simp add: algebra_simps)
              text ‹This is the end of the second substep.›

              text ‹Use the second substep to show that $x-v$ is bounded below, and therefore
              that $closestM - x$ (the endpoints of the new geodesic we want to consider in the
              inductive argument) are quantitatively closer than $uM - um$, which means that we
              will be able to use the inductive assumption over this new geodesic.›
              also have "...  (4 * exp(1/2 * ln 2)) * lambda * exp 0 * ((x - v) * exp 0)"
                apply (intro mono_intros) using delta > 0 lambda  1 v  {um..w} w  {um..x} alphaaux D > 0 C  0 I
                by (auto simp add: divide_simps mult_nonpos_nonneg)
              also have "... = (4 * exp(1/2 * ln 2)) * lambda * (x-v)"
                by simp
              also have "...  20 * lambda * (x - v)"
                apply (intro mono_intros, approximation 10)
                using delta > 0 lambda  1 v  {um..w} w  {um..x} by auto
              finally have "x - v  (1/4) * delta / lambda"
                using lambda  1 L_def delta > 0 by (simp add: divide_simps algebra_simps)
              then have "closestM - x + (1/4) * delta / lambda  closestM - v"
                by simp
              also have "...  uM - um"
                using closestM  {yM..uM} v  {um..w} by auto
              also have "...  Suc n * (1/4) * delta / lambda" by fact
              finally have "closestM - x  n * (1/4) * delta / lambda"
                unfolding Suc_eq_plus1 by (auto simp add: algebra_simps add_divide_distrib)

              text ‹Conclusion of the proof: combine the lower bound of the second substep with
              the upper bound of the first substep to get a definite gain when one goes from
              the old geodesic to the new one. Then, apply the inductive assumption to the new one
              to conclude the desired inequality for the old one.›
              have "L + 4 * delta = ((L + 4 * delta)/(L - 13 * delta)) * (L - 13 * delta)"
                using Laux delta > 0 by (simp add: algebra_simps divide_simps)
              also have "...  ((L + 4 * delta)/(L - 13 * delta)) * ((4 * exp(1/2 * ln 2)) * lambda * exp (- (1 - alpha) * D * ln 2 / (5 * delta)) * ((x - v) * exp (- alpha * 2 ^ k * dm * ln 2 / (5 * delta))))"
                apply (rule mult_left_mono) using A Laux delta > 0 by (auto simp add: divide_simps)
              also have "...  ((L + 4 * delta)/(L - 13 * delta)) * ((4 * exp(1/2 * ln 2)) * lambda * exp (- (1 - alpha) * D * ln 2 / (5 * delta)) * ((exp(-K * (closestM - x)) - exp(-K * (uM - um)))/K))"
                apply (intro mono_intros B) using Laux delta > 0 lambda  1 by (auto simp add: divide_simps)
              finally have C: "L + 4 * delta  Kmult * (exp(-K * (closestM - x)) - exp(-K * (uM - um)))"
                unfolding Kmult_def by auto

              have "Gromov_product_at (f z) (f um) (f uM)  Gromov_product_at (f z) (f x) (f closestM) + (L + 4 * delta)"
                apply (rule Rec) using closestM  {yM..uM} x  {um..ym} ym  {um..z} by auto
              also have "...  (lambda^2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (closestM - x)))) + (Kmult * (exp(-K * (closestM - x)) - exp(-K * (uM-um))))"
                apply (intro mono_intros C Suc.IH)
                using x  {um..ym} ym  {um..z} um  {a..z} closestM  {yM..uM} yM  {z..uM} uM  {z..b} closestM - x  n * (1/4) * delta / lambda by auto
              also have "... = (lambda^2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (uM - um))))"
                unfolding K_def by (simp add: algebra_simps)
              finally show ?thesis by auto
              text ‹End of the first subcase, when there is a good point $v$ between $um$ and $w$.›
            next
              case False
              text ‹Second subcase: between $um$ and $w$, all points are far away from $V_k$. We
              will show that this implies that $w$ is admissible for the step $k+1$.›
              have "w{um..ym}. (v{um..w}. (2 ^ (Suc k + 1) - 1) * dm  dist (f v) (p v))  L - 4 * delta + 7 * QC (Suc k)  dist (q (Suc k) um) (q (Suc k) w)"
              proof (rule bexI[of _ w], auto)
                show "um  w" "w  ym" using w  {um..x} x  {um..ym} by auto
                show "(4 * 2 ^ k - 1) * dm  dist (f x) (p x)" if "um  x" "x  w" for x
                  using False dm  0 that by force

                have "dist (q k um) (q (k+1) um) = 2^k * dm"
                  unfolding q_def apply (subst geodesic_segment_param(7)[where ?y = "f um"])
                  using x(3)[of um] x  {um..ym} aux by (auto simp add: metric_space_class.dist_commute, simp add: algebra_simps)
                have "dist (q k w) (q (k+1) w) = 2^k * dm"
                  unfolding q_def apply (subst geodesic_segment_param(7)[where ?y = "f w"])
                  using x(3)[of w] w  {um..x} x  {um..ym} aux by (auto simp add: metric_space_class.dist_commute, simp add: algebra_simps)
                have i: "q k um  proj_set (q (k+1) um) (V k)"
                  unfolding q_def V_def apply (rule proj_set_thickening'[of _ "f um"])
                  using p x(3)[of um] x  {um..ym} aux by (auto simp add: algebra_simps metric_space_class.dist_commute)
                have j: "q k w  proj_set (q (k+1) w) (V k)"
                  unfolding q_def V_def apply (rule proj_set_thickening'[of _ "f w"])
                  using p x(3)[of w] x  {um..ym} w  {um..x} aux by (auto simp add: algebra_simps metric_space_class.dist_commute)

                have "5 * delta + 2 * QC k  dist (q k um) (q k w)" using w(2) by simp
                also have "...  max (5 * deltaG(TYPE('a)) + 2 * QC k)
                                      (dist (q (k + 1) um) (q (k + 1) w) - dist (q k um) (q (k + 1) um) - dist (q k w) (q (k + 1) w) + 10 * deltaG(TYPE('a)) + 4 * QC k)"
                  by (rule proj_along_quasiconvex_contraction[OF ‹quasiconvex (QC k) (V k) i j])
                finally have "5 * delta + 2 * QC k  dist (q (k + 1) um) (q (k + 1) w) - dist (q k um) (q (k + 1) um) - dist (q k w) (q (k + 1) w) + 10 * deltaG(TYPE('a)) + 4 * QC k"
                  using ‹deltaG(TYPE('a)) < delta by auto
                then have "0  dist (q (k + 1) um) (q (k + 1) w) + 5 * delta + 2 * QC k - dist (q k um) (q (k + 1) um) - dist (q k w) (q (k + 1) w)"
                  using ‹deltaG(TYPE('a)) < delta by auto
                also have "... = dist (q (k + 1) um) (q (k + 1) w) + 5 * delta + 2 * QC k - 2^(k+1) * dm"
                  by (simp only: ‹dist (q k w) (q (k+1) w) = 2^k * dm ‹dist (q k um) (q (k+1) um) = 2^k * dm, auto)
                finally have *: "2^(k+1) * dm - 5 * delta - 2 * QC k  dist (q (k+1) um) (q (k+1) w)"
                  using ‹deltaG(TYPE('a)) < delta by auto
                have "L - 4 * delta + 7 * QC (k+1)  2 * dm - 5 * delta - 2 * QC k"
                  unfolding QC_def L_def using delta > 0 Laux I C  0 by auto
                also have "...  2^(k+1) * dm - 5 * delta - 2 * QC k"
                  using aux by (auto simp add: algebra_simps)
                finally show "L - 4 * delta + 7 * QC (Suc k)  dist (q (Suc k) um) (q (Suc k) w)"
                  using * by auto
              qed
              then show ?thesis
                by simp
            qed
          qed
        qed
        text ‹This is the end of the main induction over $k$. To conclude, choose $k$ large enough
        so that the second alternative in this induction is impossible. It follows that the first
        alternative holds, i.e., the desired inequality is true.›
        have "dm > 0" using I delta > 0 C  0 Laux by auto
        have "k. 2^k > dist (f um) (p um)/dm + 1"
          by (simp add: real_arch_pow)
        then obtain k where "2^k > dist (f um) (p um)/dm + 1"
          by blast
        then have "dist (f um) (p um) < (2^k - 1) * dm"
          using dm > 0 by (auto simp add: divide_simps algebra_simps)
        also have "...  (2^(Suc k) - 1) * dm"
          by (intro mono_intros, auto)
        finally have "¬((2 ^ (k + 1) - 1) * dm  dist (f um) (p um))"
          by simp
        then show "Gromov_product_at (f z) (f um) (f uM)  lambda2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp (- K * (uM - um)))"
          using Ind_k[of k] by auto
        text ‹end of the case where $D + 4 * C \leq dm$ and $dM \leq dm$.›
      next
        case 3
        text ‹This is the exact copy of the previous case, except that the roles of the points before
        and after $z$ are exchanged. In a perfect world, one would use a lemma subsuming both cases,
        but in practice copy-paste seems to work better here as there are two many details to be
        changed regarding the direction of inequalities.›
        then have I: "D + 4 * C  dM" "dm  dM" by auto
        define V where "V = (λk::nat. (gH. cball g ((2^k - 1) * dM)))"
        define QC where "QC = (λk::nat. if k = 0 then 0 else 8 * delta)"
        have "QC k  0" for k unfolding QC_def using delta > 0 by auto
        have Q: "quasiconvex (0 + 8 * deltaG(TYPE('a))) (V k)" for k
          unfolding V_def apply (rule quasiconvex_thickening) using geodesic_segmentI[OF H]
          by (auto simp add: quasiconvex_of_geodesic)
        have "quasiconvex (QC k) (V k)" for k
          apply (cases "k = 0")
          apply (simp add: V_def QC_def quasiconvex_of_geodesic geodesic_segmentI[OF H])
          apply (rule quasiconvex_mono[OF _ Q[of k]]) using ‹deltaG(TYPE('a)) < delta QC_def by auto
        define q::"nat  real  'a" where "q = (λk x. geodesic_segment_param {p x--f x} (p x) ((2^k - 1) * dM))"

        have Ind_k: "(Gromov_product_at (f z) (f um) (f uM)  lambda^2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (uM - um))))
               (x  {yM..uM}. (y  {x..uM}. dist (f y) (p y)  (2^(k+1)-1) * dM)  dist (q k uM) (q k x)  L - 4 * delta + 7 * QC k)" for k
        proof (induction k)
          case 0
          have *: "x {yM..uM}. (y  {x..uM}. dist (f y) (p y)  (2^(0+1)-1) * dM)  dist (q 0 uM) (q 0 x)  L - 4 * delta + 7 * QC 0"
          proof (rule bexI[of _ yM], auto simp add: V_def q_def QC_def)
            show "yM  uM" using yM  {z..uM} by auto
            show "L -4 * delta  dist (p uM) (p yM)"
              using yM(2) apply auto using metric_space_class.zero_le_dist[of pi_z "p uM"] by linarith
            show "y. y  uM  yM  y  dM  dist (f y) (p y)"
              using dM_def closestM proj_setD(2)[OF p] by auto
          qed
          then show ?case
            by blast
        next
          case Suck: (Suc k)
          show ?case
          proof (cases "Gromov_product_at (f z) (f um) (f uM)  lambda2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp (- K * (uM - um)))")
            case True
            then show ?thesis by simp
          next
            case False
            then obtain x where x: "x  {yM..uM}" "dist (q k uM) (q k x)  L - 4 * delta + 7 * QC k"
                                   "w. w  {x..uM}  dist (f w) (p w)  (2^(k+1)-1) * dM"
              using Suck.IH by auto
            have aux: "(2 ^ k - 1) * dM  (2*2^k-1) * dM" "0  2 * 2 ^ k - (1::real)" "dM  dM * 2 ^ k"
              apply (auto simp add: algebra_simps)
              apply (metis power.simps(2) two_realpow_ge_one)
              using 0  dM less_eq_real_def by fastforce
            have "L + C = (L/D) * (D + (D/L) * C)"
              using L > 0 D > 0 by (simp add: algebra_simps divide_simps)
            also have "...  (L/D) * (D + 4 * C)"
              apply (intro mono_intros)
              using L > 0 D > 0 C  0 D  4 * L by (auto simp add: algebra_simps divide_simps)
            also have "...  (L/D) * dM"
              apply (intro mono_intros) using I L > 0 D > 0 by auto
            finally have "L + C  (L/D) * dM"
              by simp
             moreover have "2 * delta  (2 * delta)/D * dM"
              using I C  0 delta > 0 D > 0 by (auto simp add: algebra_simps divide_simps)
            ultimately have aux2: "L + C + 2 * delta  ((L + 2 * delta)/D) * dM"
              by (auto simp add: algebra_simps divide_simps)
            have aux3: "(1-alpha) * D + alpha * 2^k * dM  dM * 2^k - C/2 - QC k"
            proof (cases "k = 0")
              case True
              show ?thesis
                 using I C  0 unfolding True QC_def alpha_def by auto
            next
              case False
              have "C/2 + QC k + (1-alpha) * D  2 * (1-alpha) * dM"
                using I C  0 unfolding QC_def alpha_def using False Laux by auto
              also have "...  2^k * (1-alpha) * dM"
                apply (intro mono_intros) using False alphaaux I D > 0 C  0 by auto
              finally show ?thesis
                by (simp add: algebra_simps)
            qed

            have "w  {x..uM}. (dist (q k uM) (q k w)  {(9 * delta + 4 * QC k) - 4 * delta - 2 * QC k .. 9 * delta + 4 * QC k})
                     (v  {w..uM}. dist (q k uM) (q k v)  9 * delta + 4 * QC k)"
            proof (rule quasi_convex_projection_small_gaps'[where ?f = f and ?G = "V k"])
              show "continuous_on {x..uM} f"
                apply (rule continuous_on_subset[OF ‹continuous_on {a..b} f])
                using uM  {z..b} z  {a..b} yM  {z..uM} x  {yM..uM} by auto
              show "x  uM" using x  {yM..uM} by auto
              show "quasiconvex (QC k) (V k)" by fact
              show "deltaG TYPE('a) < delta" by fact
              show "9 * delta + 4 * QC k  {4 * delta + 2 * QC k..dist (q k x) (q k uM)}"
                using x(2) delta > 0 QC k  0 Laux by (auto simp add: metric_space_class.dist_commute)
              show "q k w  proj_set (f w) (V k)" if "w  {x..uM}" for w
                unfolding V_def q_def apply (rule proj_set_thickening)
                using aux p x(3)[OF that] by (auto simp add: metric_space_class.dist_commute)
            qed
            then obtain w where w: "w  {x..uM}"
                                   "dist (q k uM) (q k w)  {(9 * delta + 4 * QC k) - 4 * delta - 2 * QC k .. 9 * delta + 4 * QC k}"
                                   "v. v  {w..uM}  dist (q k uM) (q k v)  9 * delta + 4 * QC k"
              by auto
            show ?thesis
            proof (cases "v  {w..uM}. dist (f v) (p v)  (2^(k+2)-1) * dM")
              case True
              then obtain v where v: "v  {w..uM}" "dist (f v) (p v)  (2^(k+2)-1) * dM"
                by auto
              have aux4: "dM * 2 ^ k  infdist (f r) (V k)" if "r  {x..v}" for r
              proof -
                have *: "q k r  proj_set (f r) (V k)"
                  unfolding q_def V_def apply (rule proj_set_thickening)
                  using aux p[of r] x(3)[of r] that v  {w..uM} w  {x..uM} by (auto simp add: metric_space_class.dist_commute)
                have "infdist (f r) (V k) = dist (geodesic_segment_param {p r--f r} (p r) (dist (p r) (f r))) (geodesic_segment_param {p r--f r} (p r) ((2 ^ k - 1) * dM))"
                  using proj_setD(2)[OF *] unfolding q_def by auto
                also have "... = abs(dist (p r) (f r) - (2 ^ k - 1) * dM)"
                  apply (rule geodesic_segment_param(7)[where ?y = "f r"])
                  using x(3)[of r] r  {x..v} v  {w..uM} w  {x..uM} aux by (auto simp add: metric_space_class.dist_commute)
                also have "... = dist (f r) (p r) - (2 ^ k - 1) * dM"
                  using x(3)[of r] r  {x..v} v  {w..uM} w  {x..uM} aux by (auto simp add: metric_space_class.dist_commute)
                finally have "dist (f r) (p r) = infdist (f r) (V k) + (2 ^ k - 1) * dM" by simp
                moreover have "(2^(k+1) - 1) * dM  dist (f r) (p r)"
                  apply (rule x(3)) using r  {x..v} v  {w..uM} w  {x..uM} by auto
                ultimately have "(2^(k+1) - 1) * dM  infdist (f r) (V k) + (2 ^ k - 1) * dM"
                  by simp
                then show ?thesis by (auto simp add: algebra_simps)
              qed

              have "infdist (f v) H  (2^(k+2)-1) * dM"
                using v proj_setD(2)[OF p[of v]] by auto
              have "dist closestm v  lambda * (infdist (f closestm) H + (L + C + 2 * delta) + infdist (f v) H)"
                apply (rule D)
                using v  {w..uM} w  {x..uM} x  {yM..uM} yM  {z..uM} uM  {z..b} z  {a..b} closestm  {um..ym} ym  {um..z} um  {a..z} by auto
              also have "...  lambda * (dm + 1 * (L + C + 2 * delta) + (2^(k+2)-1) * dM)"
                apply (intro mono_intros ‹infdist (f v) H  (2^(k+2)-1) * dM)
                using dm_def lambda  1 L > 0 C  0 delta > 0 by (auto simp add: metric_space_class.dist_commute)
              also have "...  lambda * (dM + 2^k * (((L + 2 * delta)/D) * dM) + (2^(k+2)-1) * dM)"
                apply (intro mono_intros) using I lambda  1 C  0 delta > 0 L > 0 aux2 by auto
              also have "... = lambda * 2^k * (4 + (L + 2 * delta)/D) * dM"
                by (simp add: algebra_simps)
              finally have *: "dist closestm v / (lambda * (4 + (L + 2 * delta)/D))  2^k * dM"
                using lambda  1 L > 0 D > 0 delta > 0 by (simp add: divide_simps, simp add: algebra_simps)

              have "exp(- (alpha * (2^k * dM) * ln 2 / (5 * delta)))  exp(-(alpha * (dist closestm v / (lambda * (4 + (L + 2 * delta)/D))) * ln 2 / (5 * delta)))"
                apply (intro mono_intros *) using alphaaux delta > 0 by auto
              also have "... = exp(-K * dist closestm v)"
                unfolding K_def by (simp add: divide_simps)
              also have "... = exp(-K * (v - closestm))"
                unfolding dist_real_def using v  {w..uM} w  {x..uM} x  {yM..uM} yM  {z..uM} ym  {um..z} closestm  {um..ym} K > 0 by auto
              finally have "exp(- (alpha * (2^k * dM) * ln 2 / (5 * delta)))  exp(-K * (v - closestm))"
                by simp
              then have "K * (v - x) * exp(- (alpha * (2^k * dM) * ln 2 / (5 * delta)))  K * (v - x) * exp(-K * (v - closestm))"
                apply (rule mult_left_mono)
                using delta > 0 lambda  1 v  {w..uM} w  {x..uM} K > 0 by auto
              also have "... = ((1 + K * (v - x)) - 1) * exp(- K * (v - closestm))"
                by (auto simp add: algebra_simps)
              also have "...  (exp (K * (v - x)) - 1) * exp(-K * (v - closestm))"
                by (intro mono_intros, auto)
              also have "... = exp(-K * (x - closestm)) - exp(-K * (v - closestm))"
                by (simp add: algebra_simps mult_exp_exp)
              also have "...  exp(-K * (x - closestm)) - exp(-K * (uM - um))"
                using K > 0 v  {w..uM} w  {x..uM} x  {yM..uM} yM  {z..uM} ym  {um..z} closestm  {um..ym} by auto
              finally have B: "(v - x) * exp(- alpha * 2^k * dM * ln 2 / (5 * delta)) 
                                  (exp(-K * (x - closestm)) - exp(-K * (uM - um)))/K"
                using K > 0 by (auto simp add: divide_simps algebra_simps)

              text ‹The projections of $f(v)$ and $f(x)$ on the cylinder $V_k$ are well separated,
              by construction. This implies that $v$ and $x$ themselves are well separated.›
              have "L - 4 * delta + 7 * QC k  dist (q k uM) (q k x)"
                using x by simp
              also have "...  dist (q k uM) (q k v) + dist (q k v) (q k x)"
                by (intro mono_intros)
              also have "...  (9 * delta + 4 * QC k) + dist (q k v) (q k x)"
                using w(3)[of v] v  {w..uM} by auto
              finally have "L - 13 * delta + 3 * QC k  dist (q k x) (q k v)"
                by (simp add: metric_space_class.dist_commute)
              also have "...  3 * QC k + max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (v - x) * exp(-(dM * 2^k - C/2 - QC k) * ln 2 / (5 * delta)))"
              proof (cases "k = 0")
                case True
                have "dist (q k x) (q k v)  max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (v - x) * exp(-(dM * 2^k - C/2) * ln 2 / (5 * delta)))"
                proof (rule geodesic_projection_exp_contracting[where ?G = "V k" and ?f = f])
                  show "geodesic_segment (V k)" unfolding V_def True using geodesic_segmentI[OF H] by auto
                  show "x  v" using v  {w..uM} w  {x..uM} by auto
                  show "q k v  proj_set (f v) (V k)"
                    unfolding q_def V_def apply (rule proj_set_thickening)
                    using aux p[of v] x(3)[of v] v  {w..uM} w  {x..uM} by (auto simp add: metric_space_class.dist_commute)
                  show "q k x  proj_set (f x) (V k)"
                    unfolding q_def V_def apply (rule proj_set_thickening)
                    using aux p[of x] x(3)[of x] w  {x..uM} by (auto simp add: metric_space_class.dist_commute)
                  show "15/2 * delta + C/2  dM * 2^k"
                    using I delta > 0 C  0 Laux unfolding QC_def True by auto
                  show "deltaG TYPE('a) < delta" by fact
                  show "t. t  {x..v}  dM * 2 ^ k  infdist (f t) (V k)"
                    using aux4 by auto
                  show "0  C" "0  lambda" using C  0 lambda  1 by auto
                  show "dist (f x1) (f x2)  lambda * dist x1 x2 + C" if "x1  {x..v}" "x2  {x..v}" for x1 x2
                    using quasi_isometry_onD(1)[OF assms(2)] that v  {w..uM} w  {x..uM} x  {yM..uM} yM  {z..uM} uM  {z..b} z  {a..b} by auto
                qed
                then show ?thesis unfolding QC_def True by auto
              next
                case False
                have "dist (q k x) (q k v)  2 * QC k + 8 * delta + max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (v - x) * exp(-(dM * 2^k - QC k - C/2) * ln 2 / (5 * delta)))"
                proof (rule quasiconvex_projection_exp_contracting[where ?G = "V k" and ?f = f])
                  show "quasiconvex (QC k) (V k)" by fact
                  show "x  v" using v  {w..uM} w  {x..uM} by auto
                  show "q k v  proj_set (f v) (V k)"
                    unfolding q_def V_def apply (rule proj_set_thickening)
                    using aux p[of v] x(3)[of v] v  {w..uM} w  {x..uM} by (auto simp add: metric_space_class.dist_commute)
                  show "q k x  proj_set (f x) (V k)"
                    unfolding q_def V_def apply (rule proj_set_thickening)
                    using aux p[of x] x(3)[of x] w  {x..uM} by (auto simp add: metric_space_class.dist_commute)
                  show "15/2 * delta + QC k + C/2  dM * 2^k"
                    apply (rule order_trans[of _ dM])
                    using I delta > 0 C  0 Laux unfolding QC_def by auto
                  show "deltaG TYPE('a) < delta" by fact
                  show "t. t  {x..v}  dM * 2 ^ k  infdist (f t) (V k)"
                    using aux4 by auto
                  show "0  C" "0  lambda" using C  0 lambda  1 by auto
                  show "dist (f x1) (f x2)  lambda * dist x1 x2 + C" if "x1  {x..v}" "x2  {x..v}" for x1 x2
                    using quasi_isometry_onD(1)[OF assms(2)] that v  {w..uM} w  {x..uM} x  {yM..uM} yM  {z..uM} uM  {z..b} z  {a..b} by auto
                qed
                then show ?thesis unfolding QC_def using False by (auto simp add: algebra_simps)
              qed
              finally have "L - 13 * delta  max (5 * deltaG(TYPE('a))) ((4 * exp(1/2 * ln 2)) * lambda * (v - x) * exp(-(dM * 2^k - C/2 - QC k) * ln 2 / (5 * delta)))"
                by auto
              then have "L - 13 * delta  (4 * exp(1/2 * ln 2)) * lambda * (v - x) * exp(-(dM * 2^k - C/2 - QC k) * ln 2 / (5 * delta))"
                using delta > deltaG(TYPE('a)) Laux by auto
              also have "...  (4 * exp(1/2 * ln 2)) * lambda * (v - x) * exp(-((1-alpha) * D + alpha * 2^k * dM) * ln 2 / (5 * delta))"
                apply (intro mono_intros) using aux3 delta > 0 lambda  1 v  {w..uM} w  {x..uM} by auto
              also have "... = (4 * exp(1/2 * ln 2)) * lambda * (v - x) * (exp(-(1-alpha) * D * ln 2 / (5 * delta)) * exp(-alpha * 2^k * dM * ln 2 / (5 * delta)))"
                unfolding mult_exp_exp by (auto simp add: algebra_simps divide_simps)
              finally have A: "L - 13 * delta  (4 * exp(1/2 * ln 2)) * lambda * exp(-(1-alpha) * D * ln 2 / (5 * delta)) * ((v - x) * exp(-alpha * 2^k * dM * ln 2 / (5 * delta)))"
                by (simp add: algebra_simps)

              also have "...  (4 * exp(1/2 * ln 2)) * lambda * exp 0 * ((v - x) * exp 0)"
                apply (intro mono_intros) using delta > 0 lambda  1 v  {w..uM} w  {x..uM} alphaaux D > 0 C  0 I
                by (auto simp add: divide_simps mult_nonpos_nonneg)
              also have "... = (4 * exp(1/2 * ln 2)) * lambda * (v - x)"
                by simp
              also have "...  20 * lambda * (v - x)"
                apply (intro mono_intros, approximation 10)
                using delta > 0 lambda  1 v  {w..uM} w  {x..uM} by auto
              finally have "v - x  (1/4) * delta / lambda"
                using lambda  1 L_def delta > 0 by (simp add: divide_simps algebra_simps)
              then have "x - closestm + (1/4) * delta / lambda  v - closestm"
                by simp
              also have "...  uM - um"
                using closestm  {um..ym} v  {w..uM} by auto
              also have "...  Suc n * (1/4) * delta / lambda" by fact
              finally have "x - closestm  n * (1/4) * delta / lambda"
                unfolding Suc_eq_plus1 by (auto simp add: algebra_simps add_divide_distrib)

              have "L + 4 * delta = ((L + 4 * delta)/(L - 13 * delta)) * (L - 13 * delta)"
                using Laux delta > 0 by (simp add: algebra_simps divide_simps)
              also have "...  ((L + 4 * delta)/(L - 13 * delta)) * ((4 * exp(1/2 * ln 2)) * lambda * exp (- (1 - alpha) * D * ln 2 / (5 * delta)) * ((v - x) * exp (- alpha * 2 ^ k * dM * ln 2 / (5 * delta))))"
                apply (rule mult_left_mono) using A Laux delta > 0 by (auto simp add: divide_simps)
              also have "...  ((L + 4 * delta)/(L - 13 * delta)) * ((4 * exp(1/2 * ln 2)) * lambda * exp (- (1 - alpha) * D * ln 2 / (5 * delta)) * ((exp(-K * (x - closestm)) - exp(-K * (uM - um)))/K))"
                apply (intro mono_intros B) using Laux delta > 0 lambda  1 by (auto simp add: divide_simps)
              finally have C: "L + 4 * delta  Kmult * (exp(-K * (x - closestm)) - exp(-K * (uM - um)))"
                unfolding Kmult_def by argo

              have "Gromov_product_at (f z) (f um) (f uM)  Gromov_product_at (f z) (f closestm) (f x) + (L + 4 * delta)"
                apply (rule Rec) using closestm  {um..ym} x  {yM..uM} yM  {z..uM} by auto
              also have "...  (lambda^2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (x - closestm)))) + (Kmult * (exp(-K * (x - closestm)) - exp(-K * (uM-um))))"
                apply (intro mono_intros C Suc.IH)
                using x  {yM..uM} yM  {z..uM} um  {a..z} closestm  {um..ym} ym  {um..z} uM  {z..b} x - closestm  n * (1/4) * delta / lambda by auto
              also have "... = (lambda^2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(- K * (uM - um))))"
                unfolding K_def by (simp add: algebra_simps)
              finally show ?thesis by auto
            next
              case False
              have "w{yM..uM}. (r{w..uM}. (2 ^ (Suc k + 1) - 1) * dM  dist (f r) (p r))  L - 4 * delta + 7 * QC (Suc k)  dist (q (Suc k) uM) (q (Suc k) w)"
              proof (rule bexI[of _ w], auto)
                show "w  uM" "yM  w" using w  {x..uM} x  {yM..uM} by auto
                show "(4 * 2 ^ k - 1) * dM  dist (f x) (p x)" if "x  uM" "w  x" for x
                  using False dM  0 that by force

                have "dist (q k uM) (q (k+1) uM) = 2^k * dM"
                  unfolding q_def apply (subst geodesic_segment_param(7)[where ?y = "f uM"])
                  using x(3)[of uM] x  {yM..uM} aux by (auto simp add: metric_space_class.dist_commute, simp add: algebra_simps)
                have "dist (q k w) (q (k+1) w) = 2^k * dM"
                  unfolding q_def apply (subst geodesic_segment_param(7)[where ?y = "f w"])
                  using x(3)[of w] w  {x..uM} x  {yM..uM} aux by (auto simp add: metric_space_class.dist_commute, simp add: algebra_simps)
                have i: "q k uM  proj_set (q (k+1) uM) (V k)"
                  unfolding q_def V_def apply (rule proj_set_thickening'[of _ "f uM"])
                  using p x(3)[of uM] x  {yM..uM} aux by (auto simp add: algebra_simps metric_space_class.dist_commute)
                have j: "q k w  proj_set (q (k+1) w) (V k)"
                  unfolding q_def V_def apply (rule proj_set_thickening'[of _ "f w"])
                  using p x(3)[of w] x  {yM..uM} w  {x..uM} aux by (auto simp add: algebra_simps metric_space_class.dist_commute)

                have "5 * delta + 2 * QC k  dist (q k uM) (q k w)" using w(2) by simp
                also have "...  max (5 * deltaG(TYPE('a)) + 2 * QC k)
                                      (dist (q (k + 1) uM) (q (k + 1) w) - dist (q k uM) (q (k + 1) uM) - dist (q k w) (q (k + 1) w) + 10 * deltaG(TYPE('a)) + 4 * QC k)"
                  by (rule proj_along_quasiconvex_contraction[OF ‹quasiconvex (QC k) (V k) i j])
                finally have "5 * delta + 2 * QC k  dist (q (k + 1) uM) (q (k + 1) w) - dist (q k uM) (q (k + 1) uM) - dist (q k w) (q (k + 1) w) + 10 * deltaG(TYPE('a)) + 4 * QC k"
                  using ‹deltaG(TYPE('a)) < delta by auto
                then have "0  dist (q (k + 1) uM) (q (k + 1) w) + 5 * delta + 2 * QC k - dist (q k uM) (q (k + 1) uM) - dist (q k w) (q (k + 1) w)"
                  using ‹deltaG(TYPE('a)) < delta by auto
                also have "... = dist (q (k + 1) uM) (q (k + 1) w) + 5 * delta + 2 * QC k - 2^(k+1) * dM"
                  by (simp only: ‹dist (q k w) (q (k+1) w) = 2^k * dM ‹dist (q k uM) (q (k+1) uM) = 2^k * dM, auto)
                finally have *: "2^(k+1) * dM - 5 * delta - 2 * QC k  dist (q (k+1) uM) (q (k+1) w)"
                  using ‹deltaG(TYPE('a)) < delta by auto
                have "L - 4 * delta + 7 * QC (k+1)  2 * dM - 5 * delta - 2 * QC k"
                  unfolding QC_def L_def using delta > 0 Laux I C  0 by auto
                also have "...  2^(k+1) * dM - 5 * delta - 2 * QC k"
                  using aux by (auto simp add: algebra_simps)
                finally show "L - 4 * delta + 7 * QC (Suc k)  dist (q (Suc k) uM) (q (Suc k) w)"
                  using * by auto
              qed
              then show ?thesis
                by simp
            qed
          qed
        qed
        have "dM > 0" using I delta > 0 C  0 Laux by auto
        have "k. 2^k > dist (f uM) (p uM)/dM + 1"
          by (simp add: real_arch_pow)
        then obtain k where "2^k > dist (f uM) (p uM)/dM + 1"
          by blast
        then have "dist (f uM) (p uM) < (2^k - 1) * dM"
          using dM > 0 by (auto simp add: divide_simps algebra_simps)
        also have "...  (2^(Suc k) - 1) * dM"
          by (intro mono_intros, auto)
        finally have "¬((2 ^ (k + 1) - 1) * dM  dist (f uM) (p uM))"
          by simp
        then show "Gromov_product_at (f z) (f um) (f uM)  lambda2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp (- K * (uM - um)))"
          using Ind_k[of k] by auto
      qed
    qed
  qed
  text ‹The main induction is over. To conclude, one should apply its result to the original
  geodesic segment joining the points $f(a)$ and $f(b)$.›
  obtain n::nat where "(b - a)/((1/4) * delta / lambda)  n"
    using real_arch_simple by blast
  then have "b - a  n * (1/4) * delta / lambda"
    using delta > 0 lambda  1 by (auto simp add: divide_simps)
  have "infdist (f z) G  Gromov_product_at (f z) (f a) (f b) + 2 * deltaG(TYPE('a))"
    apply (intro mono_intros) using assms by auto
  also have "...  (lambda^2 * (D + 3/2 * L + delta + 11/2 * C) - 2 * delta + Kmult * (1 - exp(-K * (b - a)))) + 2 * delta"
    apply (intro mono_intros Main[OF _ _ b - a  n * (1/4) * delta / lambda]) using assms by auto
  also have "... = lambda^2 * (D + 3/2 * L + delta + 11/2 * C) + Kmult * (1 - exp(-K * (b - a)))"
    by simp
  also have "...  lambda^2 * (D + 3/2 * L + delta + 11/2 * C) + Kmult * (1 - 0)"
    apply (intro mono_intros) using Kmult > 0 by auto
  also have "... = lambda^2 * (11/2 * C + (3200*exp(-459/50*ln 2)/ln 2 + 83) * delta)"
    unfolding Kmult_def K_def L_def alpha_def D_def using delta > 0 lambda  1 by (simp add: algebra_simps divide_simps power2_eq_square mult_exp_exp)
  also have "...  lambda^2 * (11/2 * C + 91 * delta)"
    apply (intro mono_intros, simp add: divide_simps, approximation 14)
    using delta > 0 by auto
  finally show ?thesis by (simp add: algebra_simps)
qed

text ‹Still assuming that our quasi-isometry is Lipschitz, we will improve slightly on the previous
result, first going down to the hyperbolicity constant of the space, and also showing that,
conversely, the geodesic is contained in a neighborhood of the quasi-geodesic. The argument for this
last point goes as follows. Consider a point $x$ on the geodesic. Define two sets to
be the $D$-thickenings of $[a,x]$ and $[x,b]$ respectively, where $D$ is such that any point on the
quasi-geodesic is within distance $D$ of the geodesic (as given by the previous theorem). The union
of these two sets covers the quasi-geodesic, and they are both closed and nonempty. By connectedness,
there is a point $z$ in their intersection, $D$-close both to a point $x^-$ before $x$ and to a point
$x^+$ after $x$. Then $x$ belongs to a geodesic between $x^-$ and $x^+$, which is contained in a
$4\delta$-neighborhood of geodesics from $x^+$ to $z$ and from $x^-$ to $z$ by hyperbolicity. It
follows that $x$ is at distance at most $D + 4\delta$ of $z$, concluding the proof.›

lemma (in Gromov_hyperbolic_space_geodesic) Morse_Gromov_theorem_aux2:
  fixes f::"real  'a"
  assumes "continuous_on {a..b} f"
          "lambda C-quasi_isometry_on {a..b} f"
          "geodesic_segment_between G (f a) (f b)"
  shows "hausdorff_distance (f`{a..b}) G  lambda^2 * (11/2 * C + 92 * deltaG(TYPE('a)))"
proof (cases "a  b")
  case True
  have "lambda  1" "C  0" using quasi_isometry_onD[OF assms(2)] by auto
  have *: "infdist (f z) G  lambda^2 * (11/2 * C + 91 * delta)" if "z  {a..b}" "delta > deltaG(TYPE('a))" for z delta
    by (rule Morse_Gromov_theorem_aux1[OF assms(1) assms(2) True assms(3) that])
  define D where "D = lambda^2 * (11/2 * C + 91 * deltaG(TYPE('a)))"
  have "D  0" unfolding D_def using C  0 by auto
  have I: "infdist (f z) G  D" if "z  {a..b}" for z
  proof -
    have "(infdist (f z) G/ lambda^2 - 11/2 * C)/91  delta" if "delta > deltaG(TYPE('a))" for delta
      using *[OF z  {a..b} that] lambda  1 by (auto simp add: divide_simps algebra_simps)
    then have "(infdist (f z) G/ lambda^2 - 11/2 * C)/91  deltaG(TYPE('a))"
      using dense_ge by blast
    then show ?thesis unfolding D_def using lambda  1 by (auto simp add: divide_simps algebra_simps)
  qed
  show ?thesis
  proof (rule hausdorff_distanceI)
    show "0  lambda2 * (11/2 * C + 92 * deltaG TYPE('a))" using C  0 by auto
    fix x assume "x  f`{a..b}"
    then obtain z where z: "x = f z" "z  {a..b}" by blast
    show "infdist x G  lambda2 * (11/2 * C + 92 * deltaG TYPE('a))"
      unfolding z(1) by (rule order_trans[OF I[OF z  {a..b}]], auto simp add: algebra_simps D_def)
  next
    fix x assume "x  G"
    have "infdist x (f`{a..b})  D + 1 * deltaG TYPE('a)"
    proof -
      define p where "p = geodesic_segment_param G (f a)"
      then have p: "p 0 = f a" "p (dist (f a) (f b)) = f b"
        unfolding p_def using assms(3) by auto
      obtain t where t: "x = p t" "t  {0..dist (f a) (f b)}"
        unfolding p_def using x  G ‹geodesic_segment_between G (f a) (f b) by (metis geodesic_segment_param(5) imageE)
      define Km where "Km = (z  p`{0..t}. cball z D)"
      define KM where "KM = (z  p`{t..dist (f a) (f b)}. cball z D)"
      have "f`{a..b}  Km  KM"
      proof
        fix x assume x: "x  f`{a..b}"
        have "z  G. infdist x G = dist x z"
          apply (rule infdist_proper_attained)
          using geodesic_segment_topology[OF geodesic_segmentI[OF assms(3)]] by auto
        then obtain z where z: "z  G" "infdist x G = dist x z"
          by auto
        obtain tz where tz: "z = p tz" "tz  {0..dist (f a) (f b)}"
          unfolding p_def using z  G ‹geodesic_segment_between G (f a) (f b) by (metis geodesic_segment_param(5) imageE)
        have "infdist x G  D"
          using I x  f`{a..b} by auto
        then have "dist z x  D"
          using z(2) by (simp add: metric_space_class.dist_commute)
        then show "x  Km  KM"
          unfolding Km_def KM_def using tz by force
      qed
      then have *: "f`{a..b} = (Km  f`{a..b})  (KM  f`{a..b})" by auto
      have "(Km  f`{a..b})  (KM  f`{a..b})  {}"
      proof (rule connected_as_closed_union[OF _ *])
        have "closed (f ` {a..b})"
          apply (intro compact_imp_closed compact_continuous_image) using assms(1) by auto
        have "closed Km"
          unfolding Km_def apply (intro compact_has_closed_thickening compact_continuous_image)
          apply (rule continuous_on_subset[of "{0..dist (f a) (f b)}" p])
          unfolding p_def using assms(3) t  {0..dist (f a) (f b)} by (auto simp add: isometry_on_continuous)
        then show "closed (Km  f`{a..b})"
          by (rule topological_space_class.closed_Int) fact

        have "closed KM"
          unfolding KM_def apply (intro compact_has_closed_thickening compact_continuous_image)
          apply (rule continuous_on_subset[of "{0..dist (f a) (f b)}" p])
          unfolding p_def using assms(3) t  {0..dist (f a) (f b)} by (auto simp add: isometry_on_continuous)
        then show "closed (KM  f`{a..b})"
          by (rule topological_space_class.closed_Int) fact

        show "connected (f`{a..b})"
          apply (rule connected_continuous_image) using assms(1) by auto
        have "f a  Km  f`{a..b}" using True apply auto
          unfolding Km_def apply auto apply (rule bexI[of _ 0])
          unfolding p using D  0 t(2) by auto
        then show "Km  f`{a..b}  {}" by auto
        have "f b  KM  f`{a..b}" apply auto
          unfolding KM_def apply auto apply (rule bexI[of _ "dist (f a) (f b)"])
          unfolding p using D  0 t(2) True by auto
        then show "KM  f`{a..b}  {}" by auto
      qed
      then obtain y where y: "y  f`{a..b}" "y  Km" "y  KM" by auto
      obtain tm where tm: "tm  {0..t}" "dist (p tm) y  D"
        using y(2) unfolding Km_def by auto
      obtain tM where tM: "tM  {t..dist (f a) (f b)}" "dist (p tM) y  D"
        using y(3) unfolding KM_def by auto
      define H where "H = p`{tm..tM}"
      have *: "geodesic_segment_between H (p tm) (p tM)"
        unfolding H_def p_def apply (rule geodesic_segmentI2)
        using assms(3) tm  {0..t} tM  {t..dist (f a) (f b)} isometry_on_subset
        using assms(3) geodesic_segment_param(4) by (auto) fastforce
      have "x  H"
        unfolding t(1) H_def using tm  {0..t} tM  {t..dist (f a) (f b)} by auto
      have "infdist x (f ` {a..b})  dist x y"
        by (rule infdist_le[OF y(1)])
      also have "...  max (dist (p tm) y) (dist (p tM) y) + deltaG(TYPE('a))"
        by (rule dist_le_max_dist_triangle[OF * x  H])
      finally show ?thesis
        using tm(2) tM(2) by auto
    qed
    also have "...  D + lambda^2 * deltaG TYPE('a)"
      apply (intro mono_intros) using lambda  1 by auto
    finally show "infdist x (f ` {a..b})  lambda2 * (11/2 * C + 92 * deltaG TYPE('a))"
      unfolding D_def by (simp add: algebra_simps)
  qed
next
  case False
  then have "f`{a..b} = {}"
    by auto
  then have "hausdorff_distance (f ` {a..b}) G = 0"
    unfolding hausdorff_distance_def by auto
  then show ?thesis
    using quasi_isometry_onD(4)[OF assms(2)] by auto
qed

text ‹The full statement of the Morse-Gromov Theorem, asserting that a quasi-geodesic is
within controlled distance of a geodesic with the same endpoints. It is given in the formulation
of Shchur~\cite{shchur}, with optimal control in terms of the parameters of the quasi-isometry.
This statement follows readily from the previous one and from the fact that quasi-geodesics can be
approximated by Lipschitz ones.›

theorem (in Gromov_hyperbolic_space_geodesic) Morse_Gromov_theorem:
  fixes f::"real  'a"
  assumes "lambda C-quasi_isometry_on {a..b} f"
          "geodesic_segment_between G (f a) (f b)"
  shows "hausdorff_distance (f`{a..b}) G  92 * lambda^2 * (C + deltaG(TYPE('a)))"
proof -
  have C: "C  0" "lambda  1" using quasi_isometry_onD[OF assms(1)] by auto
  consider "dist (f a) (f b)  2 * C  a  b" | "dist (f a) (f b)  2 * C  a  b" | "b < a"
    by linarith
  then show ?thesis
  proof (cases)
    case 1
    have "d. continuous_on {a..b} d  d a = f a  d b = f b
                 (x{a..b}. dist (f x) (d x)  4 * C)
                 lambda (4 * C)-quasi_isometry_on {a..b} d
                 (2 * lambda)-lipschitz_on {a..b} d
                 hausdorff_distance (f`{a..b}) (d`{a..b})  2 * C"
      apply (rule quasi_geodesic_made_lipschitz[OF assms(1)]) using 1 by auto
    then obtain d where d: "d a = f a" "d b = f b"
                        "x. x  {a..b}  dist (f x) (d x)  4 * C"
                        "lambda (4 * C)-quasi_isometry_on {a..b} d"
                        "(2 * lambda)-lipschitz_on {a..b} d"
                        "hausdorff_distance (f`{a..b}) (d`{a..b})  2 * C"
      by auto
    have a: "hausdorff_distance (d`{a..b}) G  lambda^2 * ((11/2) * (4 * C) + 92 * deltaG(TYPE('a)))"
      apply (rule Morse_Gromov_theorem_aux2) using d assms lipschitz_on_continuous_on by auto

    have "hausdorff_distance (f`{a..b}) G 
          hausdorff_distance (f`{a..b}) (d`{a..b}) + hausdorff_distance (d`{a..b}) G"
      apply (rule hausdorff_distance_triangle)
      using 1 apply simp
      by (rule quasi_isometry_on_bounded[OF d(4)], auto)
    also have "...  lambda^2 * ((11/2) * (4 * C) + 92 * deltaG(TYPE('a))) + 1 * 2 * C"
      using a d by auto
    also have "...  lambda^2 * ((11/2) * (4 * C) + 92 * deltaG(TYPE('a))) + lambda^2 * 2 * C"
      apply (intro mono_intros) using lambda  1 C  0 by auto
    also have "... = lambda^2 * (24 * C + 92 * deltaG(TYPE('a)))"
      by (simp add: algebra_simps divide_simps)
    also have "...  lambda^2 * (92 * C + 92 * deltaG(TYPE('a)))"
      apply (intro mono_intros) using lambda  1 C  0 by auto
    finally show ?thesis by (auto simp add: algebra_simps)
  next
    case 2
    have "(1/lambda) * dist a b - C  dist (f a) (f b)"
      apply (rule quasi_isometry_onD[OF assms(1)]) using 2 by auto
    also have "...  2 * C" using 2 by auto
    finally have "dist a b  3 * lambda * C"
      using C by (auto simp add: algebra_simps divide_simps)
    then have *: "b - a  3 * lambda * C" using 2 unfolding dist_real_def by auto
    show ?thesis
    proof (rule hausdorff_distanceI2)
      show "0  92 * lambda2 * (C + deltaG TYPE('a))" using C by auto
      fix x assume "x  f`{a..b}"
      then obtain t where t: "x = f t" "t  {a..b}" by auto
      have "dist x (f a)  lambda * dist t a + C"
        unfolding t(1) using quasi_isometry_onD(1)[OF assms(1) t(2)] 2 by auto
      also have "...  lambda * (b - a) + 1 * 1 * C + 0 * 0 * deltaG(TYPE('a))" using t(2) 2 C unfolding dist_real_def by auto
      also have "...  lambda * (3 * lambda * C) + lambda^2 * (92-3) * C + lambda^2 * 92 * deltaG(TYPE('a))"
        apply (intro mono_intros *) using C by auto
      finally have *: "dist x (f a)  92 * lambda2 * (C + deltaG TYPE('a))"
        by (simp add: algebra_simps power2_eq_square)
      show "yG. dist x y  92 * lambda2 * (C + deltaG TYPE('a))"
        apply (rule bexI[of _ "f a"]) using * 2 assms(2) by auto
    next
      fix x assume "x  G"
      then have "dist x (f a)  dist (f a) (f b)"
        by (meson assms geodesic_segment_dist_le geodesic_segment_endpoints(1) local.some_geodesic_is_geodesic_segment(1))
      also have "...  1 * 2 * C + lambda^2 * 0 * deltaG(TYPE('a))"
        using 2 by auto
      also have "...  lambda^2 * 92 * C + lambda^2 * 92 * deltaG(TYPE('a))"
        apply (intro mono_intros) using C by auto
      finally have *: "dist x (f a)  92 * lambda2 * (C + deltaG TYPE('a))"
        by (simp add: algebra_simps)
      show "yf`{a..b}. dist x y  92 * lambda2 * (C + deltaG TYPE('a))"
        apply (rule bexI[of _ "f a"]) using * 2 by auto
    qed
  next
    case 3
    then have "hausdorff_distance (f ` {a..b}) G = 0"
      unfolding hausdorff_distance_def by auto
    then show ?thesis
      using C by auto
  qed
qed

text ‹This theorem implies the same statement for two quasi-geodesics sharing their endpoints.›

theorem (in Gromov_hyperbolic_space_geodesic) Morse_Gromov_theorem2:
  fixes c d::"real  'a"
  assumes "lambda C-quasi_isometry_on {A..B} c"
          "lambda C-quasi_isometry_on {A..B} d"
          "c A = d A" "c B = d B"
  shows "hausdorff_distance (c`{A..B}) (d`{A..B})  184 * lambda^2 * (C + deltaG(TYPE('a)))"
proof (cases "A  B")
  case False
  then have "hausdorff_distance (c`{A..B}) (d`{A..B}) = 0" by auto
  then show ?thesis using quasi_isometry_onD[OF assms(1)] delta_nonneg by auto
next
  case True
  have "hausdorff_distance (c`{A..B}) {c A--c B}  92 * lambda^2 * (C + deltaG(TYPE('a)))"
    by (rule Morse_Gromov_theorem[OF assms(1)], auto)
  moreover have "hausdorff_distance {c A--c B} (d`{A..B})  92 * lambda^2 * (C + deltaG(TYPE('a)))"
    unfolding c A = d A c B = d B apply (subst hausdorff_distance_sym)
    by (rule Morse_Gromov_theorem[OF assms(2)], auto)
  moreover have "hausdorff_distance (c`{A..B}) (d`{A..B})  hausdorff_distance (c`{A..B}) {c A--c B} + hausdorff_distance {c A--c B} (d`{A..B})"
    apply (rule hausdorff_distance_triangle)
    using True compact_imp_bounded[OF some_geodesic_compact] by auto
  ultimately show ?thesis by auto
qed

text ‹We deduce from the Morse lemma that hyperbolicity is invariant under quasi-isometry.›

text ‹First, we note that the image of a geodesic segment under a quasi-isometry is close to
a geodesic segment in Hausdorff distance, as it is a quasi-geodesic.›

lemma geodesic_quasi_isometric_image:
  fixes f::"'a::metric_space  'b::Gromov_hyperbolic_space_geodesic"
  assumes "lambda C-quasi_isometry_on UNIV f"
          "geodesic_segment_between G x y"
  shows "hausdorff_distance (f`G) {f x--f y}  92 * lambda^2 * (C + deltaG(TYPE('b)))"
proof -
  define c where "c = f o (geodesic_segment_param G x)"
  have *: "(1 * lambda) (0 * lambda + C)-quasi_isometry_on {0..dist x y} c"
    unfolding c_def by (rule quasi_isometry_on_compose[where Y = UNIV], auto intro!: isometry_quasi_isometry_on simp add: assms)
  have "hausdorff_distance (c`{0..dist x y}) {c 0--c (dist x y)}  92 * lambda^2 * (C + deltaG(TYPE('b)))"
    apply (rule Morse_Gromov_theorem) using * by auto
  moreover have "c`{0..dist x y} = f`G"
    unfolding c_def image_comp[symmetric] using assms(2) by auto
  moreover have "c 0 = f x" "c (dist x y) = f y"
    unfolding c_def using assms(2) by auto
  ultimately show ?thesis by auto
qed

text ‹We deduce that hyperbolicity is invariant under quasi-isometry. The proof goes as follows:
we want to see that a geodesic triangle is delta-thin, i.e., a point on a side $Gxy$ is close to the
union of the two other sides $Gxz$ and $Gyz$. Pull everything back by the quasi-isometry: we obtain
three quasi-geodesic, each of which is close to the corresponding geodesic segment by the Morse lemma.
As the geodesic triangle is thin, it follows that the quasi-geodesic triangle is also thin, i.e.,
a point on $f^{-1}Gxy$ is close to $f^{-1}Gxz \cup f^{-1}Gyz$ (for some explicit, albeit large,
constant). Then push everything forward by $f$: as it is a quasi-isometry, it will again distort
distances by a bounded amount.›

lemma Gromov_hyperbolic_invariant_under_quasi_isometry_explicit:
  fixes f::"'a::geodesic_space  'b::Gromov_hyperbolic_space_geodesic"
  assumes "lambda C-quasi_isometry f"
  shows "Gromov_hyperbolic_subset (752 * lambda^3 * (C + deltaG(TYPE('b)))) (UNIV::('a set))"
proof -
  have C: "lambda  1" "C  0"
    using quasi_isometry_onD[OF assms] by auto

  text ‹The Morse lemma gives a control bounded by $K$ below. Following the proof, we deduce
  a bound on the thinness of triangles by an ugly constant $L$. We bound it by a more tractable
  (albeit still ugly) constant $M$.›
  define K where "K = 92 * lambda^2 * (C + deltaG(TYPE('b)))"
  have HD: "hausdorff_distance (f`G) {f a--f b}  K" if "geodesic_segment_between G a b" for G a b
    unfolding K_def by (rule geodesic_quasi_isometric_image[OF assms that])
  define L where "L = lambda * (4 * 1 * deltaG(TYPE('b)) + 1 * 1 * C + 2 * K)"
  define M where "M = 188 * lambda^3 * (C + deltaG(TYPE('b)))"

  have "L  lambda * (4 * lambda^2 * deltaG(TYPE('b)) + 4 * lambda^2 * C + 2 * K)"
    unfolding L_def apply (intro mono_intros) using C by auto
  also have "... = M"
    unfolding M_def K_def by (auto simp add: algebra_simps power2_eq_square power3_eq_cube)
  finally have "L  M" by simp

  text ‹After these preliminaries, we start the real argument per se, showing that triangles
  are thin in the type b.›
  have Thin: "infdist w (Gxz  Gyz)  M" if
    H: "geodesic_segment_between Gxy x y" "geodesic_segment_between Gxz x z" "geodesic_segment_between Gyz y z" "w  Gxy"
    for w x y z::'a and Gxy Gyz Gxz
  proof -
    obtain w2 where w2: "w2  {f x--f y}" "infdist (f w) {f x--f y} = dist (f w) w2"
      using infdist_proper_attained[OF proper_of_compact, of "{f x--f y}" "f w"] by auto
    have "dist (f w) w2 = infdist (f w) {f x-- f y}"
      using w2 by simp
    also have "...  hausdorff_distance (f`Gxy) {f x-- f y}"
      using geodesic_segment_topology(4)[OF geodesic_segmentI] H
      by (auto intro!: quasi_isometry_on_bounded[OF quasi_isometry_on_subset[OF assms]] infdist_le_hausdorff_distance)
    also have "...  K" using HD[OF H(1)] by simp
    finally have *: "dist (f w) w2  K" by simp

    have "infdist w2 (f`Gxz  f`Gyz)  infdist w2 ({f x--f z}  {f y--f z})
                + hausdorff_distance ({f x--f z}  {f y--f z}) (f`Gxz  f`Gyz)"
      apply (rule hausdorff_distance_infdist_triangle)
      using geodesic_segment_topology(4)[OF geodesic_segmentI] H
      by (auto intro!: quasi_isometry_on_bounded[OF quasi_isometry_on_subset[OF assms]])
    also have "...  4 * deltaG(TYPE('b)) + hausdorff_distance ({f x--f z}  {f y--f z}) (f`Gxz  f`Gyz)"
      apply (simp, rule thin_triangles[of "{f x--f z}" "f z" "f x" "{f y--f z}" "f y" "{f x--f y}" w2])
      using w2 apply auto
      using geodesic_segment_commute some_geodesic_is_geodesic_segment(1) by blast+
    also have "...  4 * deltaG(TYPE('b)) + max (hausdorff_distance {f x--f z} (f`Gxz)) (hausdorff_distance {f y--f z} (f`Gyz))"
      apply (intro mono_intros) using H by auto
    also have "...  4 * deltaG(TYPE('b)) + K"
      using HD[OF H(2)] HD[OF H(3)] by (auto simp add: hausdorff_distance_sym)
    finally have **: "infdist w2 (f`Gxz  f`Gyz)  4 * deltaG(TYPE('b)) + K" by simp

    have "infdist (f w) (f`Gxz  f`Gyz)  infdist w2 (f`Gxz  f`Gyz) + dist (f w) w2"
      by (rule infdist_triangle)
    then have A: "infdist (f w) (f`(Gxz  Gyz))  4 * deltaG(TYPE('b)) + 2 * K"
      using * ** by (auto simp add: image_Un)

    have "infdist w (Gxz  Gyz)  L + epsilon" if "epsilon > 0" for epsilon
    proof -
      have *: "epsilon/lambda > 0" using that C by auto
      have "z  f`(Gxz  Gyz). dist (f w) z < 4 * deltaG(TYPE('b)) + 2 * K + epsilon/lambda"
        apply (rule infdist_almost_attained)
        using A * H(2) by auto
      then obtain z where z: "z  Gxz  Gyz" "dist (f w) (f z) < 4 * deltaG(TYPE('b)) + 2 * K + epsilon/lambda"
        by auto

      have "infdist w (Gxz  Gyz)  dist w z"
        by (auto intro!: infdist_le z(1))
      also have "...  lambda * dist (f w) (f z) + C * lambda"
        using quasi_isometry_onD[OF assms] by (auto simp add: algebra_simps divide_simps)
      also have "...  lambda * (4 * deltaG(TYPE('b)) + 2 * K + epsilon/lambda) + C * lambda"
        apply (intro mono_intros) using z(2) C by auto
      also have "... = L + epsilon"
        unfolding K_def L_def using C by (auto simp add: algebra_simps)
      finally show ?thesis by simp
    qed
    then have "infdist w (Gxz  Gyz)  L"
      using field_le_epsilon by blast
    then show ?thesis
      using L  M by auto
  qed
  then have "Gromov_hyperbolic_subset (4 * M) (UNIV::'a set)"
    using thin_triangles_implies_hyperbolic[OF Thin] by auto
  then show ?thesis unfolding M_def by (auto simp add: algebra_simps)
qed

text ‹Most often, the precise value of the constant in the previous theorem is irrelevant,
it is used in the following form.›

theorem Gromov_hyperbolic_invariant_under_quasi_isometry:
  assumes "quasi_isometric (UNIV::('a::geodesic_space) set) (UNIV::('b::Gromov_hyperbolic_space_geodesic) set)"
  shows "delta. Gromov_hyperbolic_subset delta (UNIV::'a set)"
proof -
  obtain C lambda f where f: "lambda C-quasi_isometry_between (UNIV::'a set) (UNIV::'b set) f"
    using assms unfolding quasi_isometric_def by auto
  show ?thesis
    using Gromov_hyperbolic_invariant_under_quasi_isometry_explicit[OF quasi_isometry_betweenD(1)[OF f]] by blast
qed


text ‹A central feature of hyperbolic spaces is that a path from $x$ to $y$ can not deviate
too much from a geodesic from $x$ to $y$ unless it is extremely long (exponentially long in
terms of the distance from $x$ to $y$). This is useful both to ensure that short paths (for instance
quasi-geodesics) stay close to geodesics, see the Morse lemme below, and to ensure that paths
that avoid a given large ball of radius $R$ have to be exponentially long in terms of $R$ (this
is extremely useful for random walks). This proposition is the first non-trivial result
on hyperbolic spaces in~\cite{bridson_haefliger} (Proposition III.H.1.6). We follow their proof.

The proof is geometric, and uses the existence of geodesics and the fact that geodesic
triangles are thin. In fact, the result still holds if the space is not geodesic, as
it can be deduced by embedding the hyperbolic space in a geodesic hyperbolic space and using
the result there.›

proposition (in Gromov_hyperbolic_space_geodesic) lipschitz_path_close_to_geodesic:
  fixes c::"real  'a"
  assumes "M-lipschitz_on {A..B} c"
          "geodesic_segment_between G (c A) (c B)"
          "x  G"
  shows "infdist x (c`{A..B})  (4/ln 2) * deltaG(TYPE('a)) * max 0 (ln (B-A)) + M"
proof -
  have "M  0" by (rule lipschitz_on_nonneg[OF assms(1)])
  have Main: "a  {A..B}  b  {A..B}  a  b  b-a  2^(n+1)  geodesic_segment_between H (c a) (c b)
         y  H  infdist y (c`{A..B})  4 * deltaG(TYPE('a)) * n + M" for a b H y n
  proof (induction n arbitrary: a b H y)
    case 0
    have "infdist y (c ` {A..B})  dist y (c b)"
      apply (rule infdist_le) using b  {A..B} by auto
    moreover have "infdist y (c ` {A..B})  dist y (c a)"
      apply (rule infdist_le) using a  {A..B} by auto
    ultimately have "2 * infdist y (c ` {A..B})  dist (c a) y + dist y (c b)"
      by (auto simp add: metric_space_class.dist_commute)
    also have "... = dist (c a) (c b)"
      by (rule geodesic_segment_dist[OF ‹geodesic_segment_between H (c a) (c b) y  H])
    also have "...  M * abs(b - a)"
      using lipschitz_onD(1)[OF assms(1) a  {A..B} b  {A..B}] unfolding dist_real_def
      by (simp add: abs_minus_commute)
    also have "...  M * 2"
      using a  b b - a  2^(0 + 1) M  0 mult_left_mono by auto
    finally show ?case by simp
  next
    case (Suc n)
    define m where "m = (a + b)/2"
    have "m  {A..B}" using a  {A..B} b  {A..B} unfolding m_def by auto
    define Ha where "Ha = {c m--c a}"
    define Hb where "Hb = {c m--c b}"
    have I: "geodesic_segment_between Ha (c m) (c a)" "geodesic_segment_between Hb (c m) (c b)"
      unfolding Ha_def Hb_def by auto
    then have "Ha  {}" "Hb  {}" "compact Ha" "compact Hb"
      by (auto intro: geodesic_segment_topology)

    have *: "infdist y (Ha  Hb)  4 * deltaG(TYPE('a))"
      by (rule thin_triangles[OF I ‹geodesic_segment_between H (c a) (c b) y  H])
    then have "infdist y Ha  4 * deltaG(TYPE('a))  infdist y Hb  4 * deltaG(TYPE('a))"
      unfolding infdist_union_min[OF Ha  {} Hb  {}] by auto
    then show ?case
    proof
      assume H: "infdist y Ha  4 * deltaG TYPE('a)"
      obtain z where z: "z  Ha" "infdist y Ha = dist y z"
        using infdist_proper_attained[OF proper_of_compact[OF ‹compact Ha] Ha  {}] by auto
      have Iz: "infdist z (c`{A..B})  4 * deltaG(TYPE('a)) * n + M"
      proof (rule Suc.IH[OF a  {A..B} m  {A..B}, of Ha])
        show "a  m" unfolding m_def using a  b by auto
        show "m - a  2^(n+1)" using b - a  2^(Suc n + 1) a  b unfolding m_def by auto
        show "geodesic_segment_between Ha (c a) (c m)" by (simp add: I(1) geodesic_segment_commute)
        show "z  Ha" using z by auto
      qed
      have "infdist y (c`{A..B})  dist y z + infdist z (c`{A..B})"
        by (metis add.commute infdist_triangle)
      also have "...  4 * deltaG TYPE('a) + (4 * deltaG(TYPE('a)) * n + M)"
        using H z Iz by (auto intro: add_mono)
      finally show "infdist y (c ` {A..B})  4 * deltaG TYPE('a) * real (Suc n) + M"
        by (auto simp add: algebra_simps)
    next
      assume H: "infdist y Hb  4 * deltaG TYPE('a)"
      obtain z where z: "z  Hb" "infdist y Hb = dist y z"
        using infdist_proper_attained[OF proper_of_compact[OF ‹compact Hb] Hb  {}] by auto
      have Iz: "infdist z (c`{A..B})  4 * deltaG(TYPE('a)) * n + M"
      proof (rule Suc.IH[OF m  {A..B} b  {A..B}, of Hb])
        show "m  b" unfolding m_def using a  b by auto
        show "b - m  2^(n+1)" using b - a  2^(Suc n + 1) a  b
          unfolding m_def by (auto simp add: divide_simps)
        show "geodesic_segment_between Hb (c m) (c b)" by (simp add: I(2))
        show "z  Hb" using z by auto
      qed
      have "infdist y (c`{A..B})  dist y z + infdist z (c`{A..B})"
        by (metis add.commute infdist_triangle)
      also have "...  4 * deltaG TYPE('a) + (4 * deltaG(TYPE('a)) * n + M)"
        using H z Iz by (auto intro: add_mono)
      finally show "infdist y (c ` {A..B})  4 * deltaG TYPE('a) * real (Suc n) + M"
        by (auto simp add: algebra_simps)
    qed
  qed
  consider "B-A <0" | "B-A  0  B-A  2" | "B-A > 2" by linarith
  then show ?thesis
  proof (cases)
    case 1
    then have "c`{A..B} = {}" by auto
    then show ?thesis unfolding infdist_def using M  0 by auto
  next
    case 2
    have "infdist x (c`{A..B})  4 * deltaG(TYPE('a)) * real 0 + M"
      apply (rule Main[OF _ _ _ _ ‹geodesic_segment_between G (c A) (c B) x  G])
      using 2 by auto
    also have "...  (4/ln 2) * deltaG(TYPE('a)) * max 0 (ln (B-A)) + M"
      using delta_nonneg by auto
    finally show ?thesis by auto
  next
    case 3
    define n::nat where "n = nat(floor (log 2 (B-A)))"
    have "log 2 (B-A) > 0" using 3 by auto
    then have n: "n  log 2 (B-A)" "log 2 (B-A) < n+1"
      unfolding n_def by (auto simp add: floor_less_cancel)
    then have *: "B-A  2^(n+1)"
      by (meson le_log_of_power linear not_less one_less_numeral_iff semiring_norm(76))
    have "n  ln (B-A) * (1/ln 2)" using n unfolding log_def by auto
    then have "n  (1/ln 2) * max 0 (ln (B-A))"
      using 3 by (auto simp add: algebra_simps divide_simps)
    have "infdist x (c`{A..B})  4 * deltaG(TYPE('a)) * n + M"
      apply (rule Main[OF _ _ _ _ ‹geodesic_segment_between G (c A) (c B) x  G])
      using * 3 by auto
    also have "...  4 * deltaG(TYPE('a)) * ((1/ln 2) * max 0 (ln (B-A))) + M"
      apply (intro mono_intros) using n  (1/ln 2) * max 0 (ln (B-A)) delta_nonneg by auto
    finally show ?thesis by auto
  qed
qed

text ‹By rescaling coordinates at the origin, one obtains a variation around the previous
statement.›

proposition (in Gromov_hyperbolic_space_geodesic) lipschitz_path_close_to_geodesic':
  fixes c::"real  'a"
  assumes "M-lipschitz_on {A..B} c"
          "geodesic_segment_between G (c A) (c B)"
          "x  G"
          "a > 0"
  shows "infdist x (c`{A..B})  (4/ln 2) * deltaG(TYPE('a)) * max 0 (ln (a * (B-A))) + M/a"
proof -
  define d where "d = c o (λt. (1/a) * t)"
  have *: "(M * ((1/a)* 1))-lipschitz_on {a * A..a * B} d"
    unfolding d_def apply (rule lipschitz_on_compose, intro lipschitz_intros) using assms by auto
  have "d`{a * A..a * B} = c`{A..B}"
    unfolding d_def image_comp[symmetric]
    apply (rule arg_cong[where ?f = "image c"]) using a > 0 by auto
  then have "infdist x (c`{A..B}) = infdist x (d`{a * A..a * B})" by auto
  also have "...  (4/ln 2) * deltaG(TYPE('a)) * max 0 (ln ((a * B)- (a * A))) + M/a"
    apply (rule lipschitz_path_close_to_geodesic[OF _ _ x  G])
    using * assms unfolding d_def by auto
  finally show ?thesis by (auto simp add: algebra_simps)
qed

text ‹We can now give another proof of the Morse-Gromov Theorem, as described
in~\cite{bridson_haefliger}. It is more direct than the one we have given above, but it gives
a worse dependence in terms of the quasi-isometry constants. In particular, when $C = \delta = 0$,
it does not recover the fact that a quasi-geodesic has to coincide with a geodesic.›

theorem (in Gromov_hyperbolic_space_geodesic) Morse_Gromov_theorem_BH_proof:
  fixes c::"real  'a"
  assumes "lambda C-quasi_isometry_on {A..B} c"
  shows "hausdorff_distance (c`{A..B}) {c A--c B}  72 * lambda^2 * (C + lambda + deltaG(TYPE('a))^2)"
proof -
  have C: "C  0" "lambda  1" using quasi_isometry_onD[OF assms] by auto
  consider "B-A < 0" | "B-A  0  dist (c A) (c B)  2 * C" | "B-A  0  dist (c A) (c B) > 2 * C" by linarith
  then show ?thesis
  proof (cases)
    case 1
    then have "c`{A..B} = {}" by auto
    then show ?thesis unfolding hausdorff_distance_def using delta_nonneg C by auto
  next
    case 2
    have "(1/lambda) * dist A B - C  dist (c A) (c B)"
      apply (rule quasi_isometry_onD[OF assms]) using 2 by auto
    also have "...  2 * C" using 2 by auto
    finally have "dist A B  3 * lambda * C"
      using C by (auto simp add: algebra_simps divide_simps)
    then have *: "B - A  3 * lambda * C" using 2 unfolding dist_real_def by auto
    show ?thesis
    proof (rule hausdorff_distanceI2)
      show "0  72 * lambda^2 * (C + lambda + deltaG(TYPE('a))^2)" using C by auto
      fix x assume "x  c`{A..B}"
      then obtain t where t: "x = c t" "t  {A..B}" by auto
      have "dist x (c A)  lambda * dist t A + C"
        unfolding t(1) using quasi_isometry_onD(1)[OF assms t(2), of A] 2 by auto
      also have "...  lambda * (B-A) + C" using t(2) 2 C unfolding dist_real_def by auto
      also have "...  3 * lambda * lambda * C + 1 * 1 * C" using * C by auto
      also have "...  3 * lambda * lambda * C + lambda * lambda * C"
        apply (intro mono_intros) using C by auto
      also have "... = 4 * lambda * lambda * (C + 0 + 0^2)"
        by auto
      also have "...  72 * lambda * lambda * (C + lambda + deltaG(TYPE('a))^2)"
        apply (intro mono_intros) using C delta_nonneg by auto
      finally have *: "dist x (c A)  72 * lambda^2 * (C + lambda + deltaG(TYPE('a))^2)"
        unfolding power2_eq_square by simp
      show "y{c A--c B}. dist x y  72 * lambda^2 * (C + lambda + deltaG(TYPE('a))^2)"
        apply (rule bexI[of _ "c A"]) using * by auto
    next
      fix x assume "x  {c A-- c B}"
      then have "dist x (c A)  dist (c A) (c B)"
        by (meson geodesic_segment_dist_le geodesic_segment_endpoints(1) local.some_geodesic_is_geodesic_segment(1))
      also have "...  2 * C"
        using 2 by auto
      also have "...  2 * 1 * 1 * (C + lambda + 0)" using 2 C unfolding dist_real_def by auto
      also have "...  72 * lambda * lambda * (C + lambda + deltaG(TYPE('a)) * deltaG(TYPE('a)))"
        apply (intro mono_intros) using C delta_nonneg by auto
      finally have *: "dist x (c A)  72 * lambda * lambda * (C + lambda + deltaG(TYPE('a)) * deltaG(TYPE('a)))"
        by simp
      show "yc`{A..B}. dist x y  72 * lambda^2 * (C + lambda + deltaG(TYPE('a))^2)"
        apply (rule bexI[of _ "c A"]) unfolding power2_eq_square using * 2 by auto
    qed
  next
    case 3
    then obtain d where d: "continuous_on {A..B} d" "d A = c A" "d B = c B"
              "x. x  {A..B}  dist (c x) (d x)  4 *C"
              "lambda (4 * C)-quasi_isometry_on {A..B} d"
              "(2 * lambda)-lipschitz_on {A..B} d"
              "hausdorff_distance (c`{A..B}) (d`{A..B})  2 * C"
      using quasi_geodesic_made_lipschitz[OF assms] C(1) by fastforce

    have "A  {A..B}" "B  {A..B}" using 3 by auto

    text ‹We show that the distance of any point in the geodesic from $c(A)$ to $c(B)$ is a bounded
    distance away from the quasi-geodesic $d$, by considering a point $x$ where the distance $D$ is
    maximal and arguing around this point.

    Consider the point $x_m$ on the geodesic $[c(A), c(B)]$ at distance $2D$ from $x$, and the closest
    point $y_m$ on the image of $d$. Then the distance between $x_m$ and $y_m$ is at most $D$. Hence
    a point on $[x_m,y_m]$ is at distance at least $2D - D = D$ of $x$. In the same way, define $x_M$
    and $y_M$ on the other side of $x$. Then the excursion from $x_m$ to $y_m$, then to $y_M$ along
    $d$, then to $x_M$, has length at most $D + (\lambda \cdot 6D + C) + D$ and is always at distance
    at least $D$ from $x$. It follows from the previous lemma that $D \leq \log(length)$, which
    implies a bound on $D$.

    This argument has to be amended if $x$ is at distance $ < 2D$ from $c(A)$ or $c(B)$. In this case,
    simply use $x_m = y_m = c(A)$ or $x_M = y_M = c(B)$, then everything goes through.›

    have "x  {c A--c B}. y  {c A--c B}. infdist y (d`{A..B})  infdist x (d`{A..B})"
      by (rule continuous_attains_sup, auto intro: continuous_intros)
    then obtain x where x: "x  {c A--c B}" "y. y  {c A--c B}  infdist y (d`{A..B})  infdist x (d`{A..B})"
      by auto
    define D where "D = infdist x (d`{A..B})"
    have "D  0" unfolding D_def by (rule infdist_nonneg)
    have D_bound: "D  24 * lambda + 12 * C + 24 * deltaG(TYPE('a))^2"
    proof (cases "D  1")
      case True
      have "1 * 1 + 1 * 0 + 0 * 0  24 * lambda + 12 * C + 24 * deltaG(TYPE('a))^2"
        apply (intro mono_intros) using C delta_nonneg by auto
      then show ?thesis using True by auto
    next
      case False
      then have "D  1" by auto
      have ln2mult: "2 * ln t = ln (t * t)" if "t > 0" for t::real by (simp add: that ln_mult)
      have "infdist (c A) (d`{A..B}) = 0" using d A = c A by (metis A  {A..B} image_eqI infdist_zero)
      then have "x  c A" using D  1 D_def by auto

      define tx where "tx = dist (c A) x"
      then have "tx  {0..dist (c A) (c B)}"
        using x  {c A--c B}
        by (meson atLeastAtMost_iff geodesic_segment_dist_le some_geodesic_is_geodesic_segment(1) metric_space_class.zero_le_dist some_geodesic_endpoints(1))
      have "tx > 0" using x  c A tx_def by auto
      have x_param: "x = geodesic_segment_param {c A--c B} (c A) tx"
        using x  {c A--c B} geodesic_segment_param[OF some_geodesic_is_geodesic_segment(1)] tx_def by auto

      define tm where "tm = max (tx - 2 * D) 0"
      have "tm  {0..dist (c A) (c B)}" unfolding tm_def using tx  {0..dist (c A) (c B)} D  0 by auto
      define xm where "xm = geodesic_segment_param {c A--c B} (c A) tm"
      have "xm  {c A--c B}" using tm  {0..dist (c A) (c B)}
        by (metis geodesic_segment_param(3) local.some_geodesic_is_geodesic_segment(1) xm_def)
      have "dist xm x = abs((max (tx - 2 * D) 0) - tx)"
        unfolding xm_def tm_def x_param apply (rule geodesic_segment_param[of _ _ "c B"], auto)
        using tx  {0..dist (c A) (c B)} D  0 by auto
      also have "...  2 * D" by (simp add: 0  D tx_def)
      finally have "dist xm x  2 * D" by auto
      have "ymd`{A..B}. infdist xm (d`{A..B}) = dist xm ym"
        apply (rule infdist_proper_attained) using 3 d(1) proper_of_compact compact_continuous_image by auto
      then obtain ym where ym: "ym  d`{A..B}" "dist xm ym = infdist xm (d`{A..B})"
        by metis
      then obtain um where um: "um  {A..B}" "ym = d um" by auto
      have "dist xm ym  D"
        unfolding D_def using x ym by (simp add: xm  {c A--c B})
      have D1: "dist x z  D" if "z  {xm--ym}" for z
      proof (cases "tx - 2 * D < 0")
        case True
        then have "tm = 0" unfolding tm_def by auto
        then have "xm = c A" unfolding xm_def
          by (meson geodesic_segment_param(1) local.some_geodesic_is_geodesic_segment(1))
        then have "infdist xm (d`{A..B}) = 0"
          using d A = c A A  {A..B} by (metis image_eqI infdist_zero)
        then have "ym = xm" using ym(2) by auto
        then have "z = xm" using z  {xm--ym} geodesic_segment_between_x_x(3)
          by (metis empty_iff insert_iff some_geodesic_is_geodesic_segment(1))
        then have "z  d`{A..B}" using ym = xm ym(1) by blast
        then show "dist x z  D" unfolding D_def by (simp add: infdist_le)
      next
        case False
        then have *: "tm = tx - 2 * D" unfolding tm_def by auto
        have "dist xm x = abs((tx - 2 * D) - tx)"
          unfolding xm_def x_param * apply (rule geodesic_segment_param[of _ _ "c B"], auto)
          using False tx  {0..dist (c A) (c B)} D  0 by auto
        then have "2 * D = dist xm x" using D  0 by auto
        also have "...  dist xm z + dist x z" using metric_space_class.dist_triangle2 by auto
        also have "...  dist xm ym + dist x z"
          using z  {xm--ym} by (auto, meson geodesic_segment_dist_le some_geodesic_is_geodesic_segment(1) some_geodesic_endpoints(1))
        also have "...  D + dist x z"
          using ‹dist xm ym  D by simp
        finally show "dist x z  D" by auto
      qed

      define tM where "tM = min (tx + 2 * D) (dist (c A) (c B))"
      have "tM  {0..dist (c A) (c B)}" unfolding tM_def using tx  {0..dist (c A) (c B)} D  0 by auto
      have "tm  tM"
        unfolding tM_def using D  0 tm  {0..dist (c A) (c B)} tx  dist (c A) x tm_def by auto
      define xM where "xM = geodesic_segment_param {c A--c B} (c A) tM"
      have "xM  {c A--c B}" using tM  {0..dist (c A) (c B)}
        by (metis geodesic_segment_param(3) local.some_geodesic_is_geodesic_segment(1) xM_def)
      have "dist xM x = abs((min (tx + 2 * D) (dist (c A) (c B))) - tx)"
        unfolding xM_def tM_def x_param apply (rule geodesic_segment_param[of _ _ "c B"], auto)
        using tx  {0..dist (c A) (c B)} D  0 by auto
      also have "...  2 * D" using 0  D tx  {0..dist (c A) (c B)} by auto
      finally have "dist xM x  2 * D" by auto
      have "yMd`{A..B}. infdist xM (d`{A..B}) = dist xM yM"
        apply (rule infdist_proper_attained) using 3 d(1) proper_of_compact compact_continuous_image by auto
      then obtain yM where yM: "yM  d`{A..B}" "dist xM yM = infdist xM (d`{A..B})"
        by metis
      then obtain uM where uM: "uM  {A..B}" "yM = d uM" by auto
      have "dist xM yM  D"
        unfolding D_def using x yM by (simp add: xM  {c A--c B})
      have D3: "dist x z  D" if "z  {xM--yM}" for z
      proof (cases "tx + 2 * D > dist (c A) (c B)")
        case True
        then have "tM = dist (c A) (c B)" unfolding tM_def by auto
        then have "xM = c B" unfolding xM_def
          by (meson geodesic_segment_param(2) local.some_geodesic_is_geodesic_segment(1))
        then have "infdist xM (d`{A..B}) = 0"
          using d B = c B B  {A..B} by (metis image_eqI infdist_zero)
        then have "yM = xM" using yM(2) by auto
        then have "z = xM" using z  {xM--yM} geodesic_segment_between_x_x(3)
          by (metis empty_iff insert_iff some_geodesic_is_geodesic_segment(1))
        then have "z  d`{A..B}" using yM = xM yM(1) by blast
        then show "dist x z  D" unfolding D_def by (simp add: infdist_le)
      next
        case False
        then have *: "tM = tx + 2 * D" unfolding tM_def by auto
        have "dist xM x = abs((tx + 2 * D) - tx)"
          unfolding xM_def x_param * apply (rule geodesic_segment_param[of _ _ "c B"], auto)
          using False tx  {0..dist (c A) (c B)} D  0 by auto
        then have "2 * D = dist xM x" using D  0 by auto
        also have "...  dist xM z + dist x z" using metric_space_class.dist_triangle2 by auto
        also have "...  dist xM yM + dist x z"
          using z  {xM--yM} by (auto, meson geodesic_segment_dist_le local.some_geodesic_is_geodesic_segment(1) some_geodesic_endpoints(1))
        also have "...  D + dist x z"
          using ‹dist xM yM  D by simp
        finally show "dist x z  D" by auto
      qed

      define excursion:: "real'a" where "excursion = (λt.
        if t  {0..dist xm ym} then (geodesic_segment_param {xm--ym} xm t)
        else if t  {dist xm ym..dist xm ym + abs(uM - um)} then d (um + sgn(uM-um) * (t - dist xm ym))
        else geodesic_segment_param {yM--xM} yM (t - dist xm ym - abs (uM -um)))"
      define L where "L = dist xm ym + abs(uM - um) + dist yM xM"
      have E1: "excursion t = geodesic_segment_param {xm--ym} xm t" if "t  {0..dist xm ym}" for t
        unfolding excursion_def using that by auto
      have E2: "excursion t = d (um + sgn(uM-um) * (t - dist xm ym))" if "t  {dist xm ym..dist xm ym + abs(uM - um)}" for t
        unfolding excursion_def using that by (auto simp add: ym = d um)
      have E3: "excursion t = geodesic_segment_param {yM--xM} yM (t - dist xm ym - abs (uM -um))"
        if "t  {dist xm ym + ¦uM - um¦..dist xm ym + ¦uM - um¦ + dist yM xM}" for t
        unfolding excursion_def using that yM = d uM ym = d um by (auto simp add: sgn_mult_abs)
      have E0: "excursion 0 = xm"
        unfolding excursion_def by auto
      have EL: "excursion L = xM"
        unfolding excursion_def L_def apply (auto simp add: uM(2) um(2) sgn_mult_abs)
        by (metis (mono_tags, hide_lams) add.left_neutral add_increasing2 add_le_same_cancel1 dist_real_def
              Gromov_product_e_x_x Gromov_product_nonneg metric_space_class.dist_le_zero_iff)
      have [simp]: "L  0" unfolding L_def by auto
      have "L > 0"
      proof (rule ccontr)
        assume "¬(L > 0)"
        then have "L = 0" using L  0 by simp
        then have "xm = xM" using E0 EL by auto
        then have "tM = tm" unfolding xm_def xM_def
          using tM  {0..dist (c A) (c B)} tm  {0..dist (c A) (c B)} local.geodesic_segment_param_in_geodesic_spaces(6) by fastforce
        also have "... < tx" unfolding tm_def using tx > 0 D  1 by auto
        also have "...  tM" unfolding tM_def using D  0 tx  {0..dist (c A) (c B)} by auto
        finally show False by simp
      qed

      have "(1/lambda) * dist um uM - (4 * C)  dist (d um) (d uM)"
        by (rule quasi_isometry_onD(2)[OF lambda (4 * C)-quasi_isometry_on {A..B} d um  {A..B} uM  {A..B}])
      also have "...  dist ym xm + dist xm x + dist x xM + dist xM yM"
        unfolding um(2)[symmetric] uM(2)[symmetric] by (rule dist_triangle5)
      also have "...  D + (2*D) + (2*D) + D"
        using ‹dist xm ym  D ‹dist xm x  2*D ‹dist xM x  2*D ‹dist xM yM  D
        by (auto simp add: metric_space_class.dist_commute intro: add_mono)
      finally have "(1/lambda) * dist um uM  6*D + 4*C" by auto
      then have "dist um uM  6*D*lambda + 4*C*lambda"
        using C by (auto simp add: divide_simps algebra_simps)
      then have "L  D + (6*D*lambda + 4*C*lambda) + D"
        unfolding L_def dist_real_def using ‹dist xm ym  D ‹dist xM yM  D
        by (auto simp add: metric_space_class.dist_commute intro: add_mono)
      also have "...  8 * D * lambda + 4*C*lambda"
        using C D  0 by (auto intro: mono_intros)
      finally have L_bound: "L  lambda * (8 * D + 4 * C)"
        by (auto simp add: algebra_simps)

      have "1 * (1 * 1 + 0)  lambda * (8 * D + 4 * C)"
        using C D  1 by (intro mono_intros, auto)

      consider "um < uM" | "um = uM" | "um > uM" by linarith
      then have "((λt. um + sgn (uM - um) * (t - dist xm ym)) ` {dist xm ym..dist xm ym + ¦uM - um¦})  {min um uM..max um uM}"
        by (cases, auto)
      also have "...  {A..B}" using um  {A..B} uM  {A..B} by auto
      finally have middle: "((λt. um + sgn (uM - um) * (t - dist xm ym)) ` {dist xm ym..dist xm ym + ¦uM - um¦})  {A..B}"
        by simp

      have "(2 * lambda)-lipschitz_on {0..L} excursion"
      proof (unfold L_def, rule lipschitz_on_closed_Union[of "{{0..dist xm ym}, {dist xm ym..dist xm ym + abs(uM - um)}, {dist xm ym + abs(uM - um)..dist xm ym + abs(uM - um) + dist yM xM}}" _ "λ i. i"], auto)
        show "lambda  0" using C by auto

        have *: "1-lipschitz_on {0..dist xm ym} (geodesic_segment_param {xm--ym} xm)"
          by (rule isometry_on_lipschitz, simp)
        have **: "1-lipschitz_on {0..dist xm ym} excursion"
          using lipschitz_on_transform[OF * E1] by simp
        show "(2 * lambda)-lipschitz_on {0..dist xm ym} excursion"
          apply (rule lipschitz_on_mono[OF **]) using C by auto

        have *: "(1*(1+0))-lipschitz_on {dist xm ym + ¦uM - um¦..dist xm ym + ¦uM - um¦ + dist yM xM}
                ((geodesic_segment_param {yM--xM} yM) o (λt. t - (dist xm ym + abs (uM -um))))"
          by (intro lipschitz_intros, rule isometry_on_lipschitz, auto)
        have **: "(1*(1+0))-lipschitz_on {dist xm ym + ¦uM - um¦..dist xm ym + ¦uM - um¦ + dist yM xM} excursion"
          apply (rule lipschitz_on_transform[OF *]) using E3 unfolding comp_def by (auto simp add: algebra_simps)
        show "(2 * lambda)-lipschitz_on {dist xm ym + ¦uM - um¦..dist xm ym + ¦uM - um¦ + dist yM xM} excursion"
          apply (rule lipschitz_on_mono[OF **]) using C by auto

        have **: "((2 * lambda) * (0 + abs(sgn (uM - um)) * (1 + 0)))-lipschitz_on {dist xm ym..dist xm ym + abs(uM - um)} (d o (λt. um + sgn(uM-um) * (t - dist xm ym)))"
          apply (intro lipschitz_intros, rule lipschitz_on_subset[OF _ middle])
          using (2 * lambda)-lipschitz_on {A..B} d by simp
        have ***: "(2 * lambda)-lipschitz_on {dist xm ym..dist xm ym + abs(uM - um)} (d o (λt. um + sgn(uM-um) * (t - dist xm ym)))"
          apply (rule lipschitz_on_mono[OF **]) using C by auto
        show "(2 * lambda)-lipschitz_on {dist xm ym..dist xm ym + abs(uM - um)} excursion"
          apply (rule lipschitz_on_transform[OF ***]) using E2 by auto
      qed

      have *: "dist x z  D" if z: "z  excursion`{0..L}" for z
      proof -
        obtain tz where tz: "z = excursion tz" "tz  {0..dist xm ym + abs(uM - um) + dist yM xM}"
          using z L_def by auto
        consider "tz  {0..dist xm ym}" | "tz  {dist xm ym<..dist xm ym + abs(uM - um)}" | "tz  {dist xm ym + abs(uM - um)<..dist xm ym + abs(uM - um) + dist yM xM}"
          using tz by force
        then show ?thesis
        proof (cases)
          case 1
          then have "z  {xm--ym}" unfolding tz(1) excursion_def by auto
          then show ?thesis using D1 by auto
        next
          case 3
          then have "z  {yM--xM}" unfolding tz(1) excursion_def using tz(2) by auto
          then show ?thesis using D3 by (simp add: some_geodesic_commute)
        next
          case 2
          then have "z  d`{A..B}" unfolding tz(1) excursion_def using middle by force
          then show ?thesis unfolding D_def by (simp add: infdist_le)
        qed
      qed

      text ‹Now comes the main point: the excursion is always at distance at least $D$ of $x$,
      but this distance is also bounded by the log of its length, i.e., essentially $\log D$. To
      have an efficient estimate, we use a rescaled version, to get rid of one term on the right
      hand side.›
      have "1 * 1 * 1 * (1 + 0/1)  512 * lambda * lambda * (1+C/D)"
        apply (intro mono_intros) using lambda  1 D  1 C  0 by auto
      then have "ln (512 * lambda * lambda * (1+C/D))  0"
        apply (subst ln_ge_zero_iff) by auto
      define a where "a = 64 * lambda/D"
      have "a > 0" unfolding a_def using D  1 lambda  1 by auto

      have "D  infdist x (excursion`{0..L})"
        unfolding infdist_def apply auto apply (rule cInf_greatest) using * by auto
      also have "...  (4/ln 2) * deltaG(TYPE('a)) * max 0 (ln (a * (L-0))) + (2 * lambda) / a"
      proof (rule lipschitz_path_close_to_geodesic'[of _ _ _ _ "geodesic_subsegment {c A--c B} (c A) tm tM"])
        show "(2 * lambda)-lipschitz_on {0..L} excursion" by fact
        have *: "geodesic_subsegment {c A--c B} (c A) tm tM = geodesic_segment_param {c A--c B} (c A) ` {tm..tM} "
          apply (rule geodesic_subsegment(1)[of _ _ "c B"])
          using tm  {0..dist (c A) (c B)} tM  {0..dist (c A) (c B)} tm  tM by auto
        show "x  geodesic_subsegment {c A--c B} (c A) tm tM"
          unfolding * unfolding x_param tm_def tM_def using tx  {0..dist (c A) (c B)} 0  D by simp
        show "geodesic_segment_between (geodesic_subsegment {c A--c B} (c A) tm tM) (excursion 0) (excursion L)"
          unfolding E0 EL xm_def xM_def apply (rule geodesic_subsegment[of _ _ "c B"])
          using tm  {0..dist (c A) (c B)} tM  {0..dist (c A) (c B)} tm  tM by auto
      qed (fact)
      also have "... = (4/ln 2) * deltaG(TYPE('a)) * max 0 (ln (a *L)) + D/32"
        unfolding a_def using D  1 lambda  1 by (simp add: algebra_simps)
      finally have "(31 * ln 2 / 128) * D  deltaG(TYPE('a)) * max 0 (ln (a * L))"
        by (auto simp add: algebra_simps divide_simps)
      also have "...  deltaG(TYPE('a)) * max 0 (ln ((64 * lambda/D) * (lambda * (8 * D + 4 * C))))"
        unfolding a_def apply (intro mono_intros)
        using L_bound L > 0 lambda  1 D  1 by auto
      also have "...  deltaG(TYPE('a)) * max 0 (ln ((64 * lambda/D) * (lambda * (8 * D + 8 * C))))"
        apply (intro mono_intros)
        using L_bound L > 0 lambda  1 D  1 C  0 by auto
      also have "... = deltaG(TYPE('a)) * max 0 (ln (512 * lambda * lambda * (1+C/D)))"
        using D  1 by (auto simp add: algebra_simps)
      also have "... = deltaG(TYPE('a)) * ln (512 * lambda * lambda * (1+C/D))"
        using ‹ln (512 * lambda * lambda * (1+C/D))  0 by auto
      also have "...  deltaG(TYPE('a)) * ln (512 * lambda * lambda * (1+C/1))"
        apply (intro mono_intros) using lambda  1 C  0 D  1
        by (auto simp add: divide_simps mult_ge1_mono(1))
      text ‹We have obtained a bound on $D$, of the form $D \leq M \delta \ln(M \lambda^2(1+C))$.
      This is a nice bound, but we tweak it a little bit to obtain something more manageable,
      without the logarithm.›
      also have "... = deltaG(TYPE('a)) * (ln 512 + 2 * ln lambda + ln (1+C))"
        apply (subst ln2mult) using C  0 lambda  1 apply simp
        apply (subst ln_mult[symmetric]) apply simp using C  0 lambda  1 apply simp
        apply (subst ln_mult[symmetric]) using C  0 lambda  1 by auto
      also have "... = (deltaG(TYPE('a)) * 1) * ln 512 + 2 * (deltaG(TYPE('a)) * ln lambda) + (deltaG(TYPE('a)) * ln (1+C))"
        by (auto simp add: algebra_simps)
      text ‹For each term, of the form $\delta \ln c$, we bound it by $(\delta^2 + (\ln c)^2)/2$, and
      then bound $(\ln c)^2$ by $2c-2$. In fact, to get coefficients of the same order of
      magnitude on $\delta^2$ and $\lambda$, we tweak a little bit the inequality for the last two
      terms, using rather $uv \leq (u^2/2 + 2v^2)/2$. We also bound $\ln(32)$ by a good
      approximation $16/3$.›
      also have "...  (deltaG(TYPE('a))^2/2 + 1^2/2) * (25/4)
            + 2 * ((1/2) * deltaG(TYPE('a))^2/2 + 2 * (ln lambda)^2 / 2) + ((1/2) * deltaG(TYPE('a))^2/2 + 2 * (ln (1+C))^2 / 2)"
        by (intro mono_intros, auto, approximation 10)
      also have "... = (31/8) * deltaG(TYPE('a))^2 + 25/8 + 2 * (ln lambda)^2 + (ln (1+C))^2"
        by (auto simp add: algebra_simps)
      also have "...  4 * deltaG(TYPE('a))^2 + 4 + 2 * (2 * lambda - 2) + (2 * (1+C) - 2)"
        apply (intro mono_intros) using C  0 lambda  1 by auto
      also have "...  4 * deltaG(TYPE('a))^2 + 4 * lambda + 2 * C"
        by auto
      finally have "D  (128 / (31 * ln 2)) * (4 * deltaG(TYPE('a))^2 + 4 * lambda + 2 * C)"
        by (auto simp add: divide_simps algebra_simps)
      also have "...  6 * (4 * deltaG(TYPE('a))^2 + 4 * lambda + 2 * C)"
        apply (intro mono_intros, approximation 10) using lambda  1 C  0 by auto
      also have "...  24 * deltaG(TYPE('a))^2 + 24 * lambda + 12 * C"
        using lambda  1 C  0 by auto
      finally show ?thesis by simp
    qed
    define D0 where "D0 = 24 * lambda + 12 * C + 24 * deltaG(TYPE('a))^2"
    have first_step: "infdist y (d`{A..B})  D0" if "y  {c A--c B}" for y
      using x(2)[OF that] D_bound unfolding D0_def D_def by auto
    have "1 * 1 + 4 * 0 + 24 * 0  D0"
      unfolding D0_def apply (intro mono_intros) using C delta_nonneg by auto
    then have "D0 > 0" by simp
    text ‹This is the end of the first step, i.e., showing that $[c(A), c(B)]$ is included in
    the neighborhood of size $D0$ of the quasi-geodesic.›

    text ‹Now, we start the second step: we show that the quasi-geodesic is included in the
    neighborhood of size $D1$ of the geodesic, where $D1 \geq D0$ is the constant defined below.
    The argument goes as follows. Assume that a point $y$ on the quasi-geodesic is at distance $ > D0$
    of the geodesic. Consider the last point $y_m$ before $y$ which is at distance $D0$ of the
    geodesic, and the first point $y_M$ after $y$ likewise. On $(y_m, y_M)$, one is always at distance
    $ > D0$ of the geodesic. However, by the first step, the geodesic is covered by the balls of radius
    $D0$ centered at points on the quasi-geodesic -- and only the points before $y_m$ or after $y_M$
    can be used. Let $K_m$ be the points on the geodesics that are at distance $\leq D0$ of a point
    on the quasi-geodesic before $y_m$, and likewise define $K_M$. These are two closed subsets of
    the geodesic. By connectedness, they have to intersect. This implies that some points before $y_m$
    and after $y_M$ are at distance at most $2D0$. Since we are dealing with a quasi-geodesic, this
    gives a bound on the distance between $y_m$ and $y_M$, and therefore a bound between $y$ and the
    geodesic, as desired.›

    define D1 where "D1 = lambda * lambda * (72 * lambda + 44 * C + 72 * deltaG(TYPE('a))^2)"
    have "1 * 1 * (24 * lambda + 12 * C + 24 * deltaG(TYPE('a))^2)
             lambda * lambda * (72 * lambda + 44 * C + 72 * deltaG(TYPE('a))^2)"
      apply (intro mono_intros) using C by auto
    then have "D0  D1" unfolding D0_def D1_def by auto
    have second_step: "infdist y {c A--c B}  D1" if "y  d`{A..B}" for y
    proof (cases "infdist y {c A--c B}  D0")
      case True
      then show ?thesis using D0  D1 by auto
    next
      case False
      obtain ty where "ty  {A..B}" "y = d ty" using y  d`{A..B} by auto

      define tm where "tm = Sup ((λt. infdist (d t) {c A--c B})-`{..D0}  {A..ty})"
      have tm: "tm  (λt. infdist (d t) {c A--c B})-`{..D0}  {A..ty}"
      unfolding tm_def proof (rule closed_contains_Sup)
        show "closed ((λt. infdist (d t) {c A--c B})-`{..D0}  {A..ty})"
          apply (rule closed_vimage_Int, auto, intro continuous_intros)
          apply (rule continuous_on_subset[OF d(1)]) using ty  {A..B} by auto
        have "A  (λt. infdist (d t) {c A--c B})-`{..D0}  {A..ty}"
          using D0 > 0 ty  {A..B} by (auto simp add: d A = c A)
        then show "(λt. infdist (d t) {c A--c B})-`{..D0}  {A..ty}  {}" by auto
        show "bdd_above ((λt. infdist (d t) {c A--c B}) -` {..D0}  {A..ty})" by auto
      qed
      have *: "infdist (d t) {c A--c B} > D0" if "t  {tm<..ty}" for t
      proof (rule ccontr)
        assume "¬(infdist (d t) {c A--c B} > D0)"
        then have *: "t  (λt. infdist (d t) {c A--c B})-`{..D0}  {A..ty}"
          using that tm by auto
        have "t  tm" unfolding tm_def apply (rule cSup_upper) using * by auto
        then show False using that by auto
      qed

      define tM where "tM = Inf ((λt. infdist (d t) {c A--c B})-`{..D0}  {ty..B})"
      have tM: "tM  (λt. infdist (d t) {c A--c B})-`{..D0}  {ty..B}"
      unfolding tM_def proof (rule closed_contains_Inf)
        show "closed ((λt. infdist (d t) {c A--c B})-`{..D0}  {ty..B})"
          apply (rule closed_vimage_Int, auto, intro continuous_intros)
          apply (rule continuous_on_subset[OF d(1)]) using ty  {A..B} by auto
        have "B  (λt. infdist (d t) {c A--c B})-`{..D0}  {ty..B}"
          using D0 > 0 ty  {A..B} by (auto simp add: d B = c B)
        then show "(λt. infdist (d t) {c A--c B})-`{..D0}  {ty..B}  {}" by auto
        show "bdd_below ((λt. infdist (d t) {c A--c B}) -` {..D0}  {ty..B})" by auto
      qed
      have "infdist (d t) {c A--c B} > D0" if "t  {ty..<tM}" for t
      proof (rule ccontr)
        assume "¬(infdist (d t) {c A--c B} > D0)"
        then have *: "t  (λt. infdist (d t) {c A--c B})-`{..D0}  {ty..B}"
          using that tM by auto
        have "t  tM" unfolding tM_def apply (rule cInf_lower) using * by auto
        then show False using that by auto
      qed
      then have lower_tm_tM: "infdist (d t) {c A--c B} > D0" if "t  {tm<..<tM}" for t
        using * that by (cases "t  ty", auto)

      define Km where "Km = (z  d`{A..tm}. cball z D0)"
      define KM where "KM = (z  d`{tM..B}. cball z D0)"
      have "{c A--c B}  Km  KM"
      proof
        fix x assume "x  {c A--c B}"
        have "z  d`{A..B}. infdist x (d`{A..B}) = dist x z"
          apply (rule infdist_proper_attained[OF proper_of_compact], rule compact_continuous_image[OF ‹continuous_on {A..B} d])
          using that by auto
        then obtain tx where "tx  {A..B}" "infdist x (d`{A..B}) = dist x (d tx)" by blast
        then have "dist x (d tx)  D0"
          using first_step[OF x  {c A--c B}] by auto
        then have "x  cball (d tx) D0" by (auto simp add: metric_space_class.dist_commute)
        consider "tx  {A..tm}" | "tx  {tm<..<tM}" | "tx  {tM..B}"
          using tx  {A..B} by fastforce
        then show "x  Km  KM"
        proof (cases)
          case 1
          then have "x  Km" unfolding Km_def using x  cball (d tx) D0 by auto
          then show ?thesis by simp
        next
          case 3
          then have "x  KM" unfolding KM_def using x  cball (d tx) D0 by auto
          then show ?thesis by simp
        next
          case 2
          have "infdist (d tx) {c A--c B}  dist (d tx) x" using x  {c A--c B} by (rule infdist_le)
          also have "...  D0" using x  cball (d tx) D0 by auto
          finally have False using lower_tm_tM[OF 2] by simp
          then show ?thesis by simp
        qed
      qed
      then have *: "{c A--c B} = (Km  {c A--c B})  (KM  {c A--c B})" by auto
      have "(Km  {c A--c B})  (KM  {c A--c B})  {}"
      proof (rule connected_as_closed_union[OF _ *])
        have "closed Km"
          unfolding Km_def apply (rule compact_has_closed_thickening)
          apply (rule compact_continuous_image)
          apply (rule continuous_on_subset[OF ‹continuous_on {A..B} d])
          using tm ty  {A..B} by auto
        then show "closed (Km  {c A--c B})" by (rule topological_space_class.closed_Int, auto)

        have "closed KM"
          unfolding KM_def apply (rule compact_has_closed_thickening)
          apply (rule compact_continuous_image)
          apply (rule continuous_on_subset[OF ‹continuous_on {A..B} d])
          using tM ty  {A..B} by auto
        then show "closed (KM  {c A--c B})" by (rule topological_space_class.closed_Int, auto)

        show "connected {c A--c B}" by simp
        have "c A  Km  {c A--c B}" apply auto
          unfolding Km_def using tm d A = c A D0 > 0 by (auto) (rule bexI[of _ A], auto)
        then show "Km  {c A--c B}  {}" by auto
        have "c B  KM  {c A--c B}" apply auto
          unfolding KM_def using tM d B = c B D0 > 0 by (auto) (rule bexI[of _ B], auto)
        then show "KM  {c A--c B}  {}" by auto
      qed
      then obtain w where "w  {c A--c B}" "w  Km" "w  KM" by auto
      then obtain twm twM where tw: "twm  {A..tm}" "w  cball (d twm) D0" "twM  {tM..B}" "w  cball (d twM) D0"
        unfolding Km_def KM_def by auto
      have "(1/lambda) * dist twm twM - (4*C)  dist (d twm) (d twM)"
        apply (rule quasi_isometry_onD(2)[OF d(5)]) using tw tm tM by auto
      also have "...  dist (d twm) w + dist w (d twM)"
        by (rule metric_space_class.dist_triangle)
      also have "...  2 * D0" using tw by (auto simp add: metric_space_class.dist_commute)
      finally have "dist twm twM  lambda * (4*C + 2*D0)"
        using C by (auto simp add: divide_simps algebra_simps)
      then have *: "dist twm ty  lambda * (4*C + 2*D0)"
        using tw tm tM dist_real_def by auto

      have "dist (d ty) w  dist (d ty) (d twm) + dist (d twm) w"
        by (rule metric_space_class.dist_triangle)
      also have "...  (lambda * dist ty twm + (4*C)) + D0"
        apply (intro add_mono, rule quasi_isometry_onD(1)[OF d(5)]) using tw tm tM by auto
      also have "...  (lambda * (lambda * (4*C + 2*D0))) + (4*C) + D0"
        apply (intro mono_intros) using C * by (auto simp add: metric_space_class.dist_commute)
      also have "... = lambda * lambda * (4*C + 2*D0) + 1 * 1 * (4 * C) + 1 * 1 * D0"
        by simp
      also have "...  lambda * lambda * (4*C + 2*D0) + lambda * lambda * (4 * C) + lambda * lambda * D0"
        apply (intro mono_intros) using C * D0 > 0 by auto
      also have "... = lambda * lambda * (8 * C + 3 * D0)"
        by (auto simp add: algebra_simps)
      also have "... = lambda * lambda * (44 * C + 72 * lambda + 72 * deltaG(TYPE('a))^2)"
        unfolding D0_def by auto
      finally have "dist y w  D1" unfolding D1_def y = d ty by (auto simp add: algebra_simps)
      then show "infdist y {c A--c B}  D1" using infdist_le[OF w  {c A--c B}, of y] by auto
    qed
    text ‹This concludes the second step.›

    text ‹Putting the two steps together, we deduce that the Hausdorff distance between the
    geodesic and the quasi-geodesic is bounded by $D1$. A bound between the geodesic and
    the original (untamed) quasi-geodesic follows.›

    have a: "hausdorff_distance (d`{A..B}) {c A--c B}  D1"
    proof (rule hausdorff_distanceI)
      show "D1  0" unfolding D1_def using C delta_nonneg by auto
      fix x assume "x  d ` {A..B}"
      then show "infdist x {c A--c B}  D1" using second_step by auto
    next
      fix x assume "x  {c A--c B}"
      then show "infdist x (d`{A..B})  D1" using first_step D0  D1 by force
    qed

    have "hausdorff_distance (c`{A..B}) {c A--c B} 
        hausdorff_distance (c`{A..B}) (d`{A..B}) + hausdorff_distance (d`{A..B}) {c A--c B}"
      apply (rule hausdorff_distance_triangle)
      using A  {A..B} apply blast
      by (rule quasi_isometry_on_bounded[OF d(5)], auto)
    also have "...  D1 + 2*C" using a d by auto
    also have "... = lambda * lambda * (72 * lambda + 44 * C + 72 * deltaG(TYPE('a))^2) + 1 * 1 * (2 * C)"
      unfolding D1_def by auto
    also have "...  lambda * lambda * (72 * lambda + 44 * C + 72 * deltaG(TYPE('a))^2)
                      + lambda * lambda * (28 * C)"
      apply (intro mono_intros) using C delta_nonneg by auto
    also have "... = 72 * lambda^2 * (lambda + C + deltaG(TYPE('a))^2)"
      by (auto simp add: algebra_simps power2_eq_square)
    finally show ?thesis by (auto simp add: algebra_simps)
  qed
qed

end (*of theory Morse_Gromov_Theorem*)

Theory Bonk_Schramm_Extension

(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
    License: BSD
*)

section ‹The Bonk Schramm extension›

theory Bonk_Schramm_Extension
  imports Morse_Gromov_Theorem
begin

text ‹We want to show that any metric space is isometrically embedded in a
metric space which is geodesic (i.e., there is an embedded geodesic between any
two points) and complete. There are many such constructions, but a very interesting one
has been given by Bonk and Schramm in~\cite{bonk_schramm}, together with an additional property of the
completion: if the space is delta-hyperbolic (in the sense of Gromov), then its
completion also is, with the same constant delta. It follows in particular that a $0$-hyperbolic
space embeds in a $0$-hyperbolic geodesic space, i.e., a metric tree (there is an easier
direct construction in this case).

Another embedding of a metric space in a geodesic one is constructed by Mineyev~\cite{mineyev},
it is more canonical in a sense (isometries of the original space extend
to the new space), but it is not clear if it preserves hyperbolicity.

The argument of Bonk and Schramm goes as follows:
- first, if one wants to add the middle of a pair of points $a$ and $b$ in a space $E$, there is a
nice formula for the distance on a new space $E \cup \{*\}$ (where $*$ will by construction be a middle
of $a$ and $b$).
- by transfinite induction on all the pair of points in the space, one adds
all the missing middles
- then one completes the space
- then one adds all the middles
- then one goes on like that, transfinitely many times
- at some point, the process stops for cardinality reasons

The resulting space is complete and has middles for all pairs of points. It is then
standard that it is geodesic (this is proved in \verb+Geodesic_Spaces.thy+).

Implementing this construction in Isabelle is interesting and nontrivial,
as transfinite induction is not that easy, especially when intermingled with metric completion
(i.e., taking the quotient space of all Cauchy sequences). In particular, taking sequences of
metric completions would mean changing types at each step, along a transfinite number of steps.
It does not seem possible to do it naively in this way.

We avoid taking quotients in the middle of the argument, as this is too messy.
Instead, we define a pseudo-distance (i.e., a function satisyfing the
triangular inequality, but such that $d(x,y)$ can vanish even if $x$ and $y$ are different)
on an increasing set, which should contain middles and limits of Cauchy sequences
(identified with their defining Cauchy sequence). Thus, we consider a datatype containing
points in the original space and closed under two operations: taking a pair of points in the datatype
(we think of the resulting pair as the middle of the pair) and taking a sequence with
values in the datatype (we think of the resulting sequence as the limit of the sequence if
it is Cauchy, for a distance yet to be defined, and as something we discard if the sequence
is not Cauchy).

Defining such an object is apparently not trivial. However, it is
well defined, for cardinality reasons, as this process will end
after the continuum cardinality iterations (as a sequence taking value in the continuum
cardinality is in fact contained in a strictly smaller ordinal, which means that all
sequences in the construction will appear at a step strictly before the continuum cardinality).
The datatype construction in Isabelle/HOL contains these cardinality considerations
as an automatic process, and is thus able to construct the datatype directly,
without the need for any additional proof!

Then, we define a wellorder on the datatype, such that every middle and every sequence appear
after each of its ancestors. This construction of a wellorder should work for any datatype,
but we provide a naive proof in our use case.

Then, we define, inductively on $z$, a pseudodistance on the pair of points in
$\{x : x \leq z\}$. In the induction, one should add one point at a time. If it is
a middle, one uses the Bonk-Schramm recipe. If it is a sequence, then either the sequence
is Cauchy and one uses the limit of the distances to the points in the sequence,
or it is not Cauchy and one discards the new point by setting $d(a,a) = 1$.
(This means that, in the Bonk-Schramm recipe, we only use the points with $d(x,x) = 0$,
and show the triangular inequality there).

In the end, we obtain a space with a pseudodistance. The desired space is obtained
by quotienting out the space $\{x : d(x,x) = 0\}$ by the equivalence relation
given by $d(x,y) = 0$. The triangular inequality for the pseudo-distance shows
that it descends to a genuine distance on the quotient. This is the desired
geodesic complete extension of the original space.
›

subsection ‹Unfolded Bonk Schramm extension›

text ‹The unfolded Bonk Schramm extension, as explained at the beginning of this file, is a type made
of the initial type, adding all possible middles and all possible limits of Cauchy sequences,
without any quotienting process›

datatype 'a Bonk_Schramm_extension_unfolded =
  basepoint 'a
  | middle "'a Bonk_Schramm_extension_unfolded" "'a Bonk_Schramm_extension_unfolded"
  | would_be_Cauchy "nat  'a Bonk_Schramm_extension_unfolded"

context metric_space
begin

text ‹The construction of the distance will be done by transfinite induction,
with respect to a well-order for which the basepoints form an initial segment,
and for which middles of would-be Cauchy sequences are larger than the elements
they are made of. We will first prove the existence of such a well-order.

The idea is first to construct a function \verb+map_aux+ to another type, with a
well-order \verb+wo_aux+, such
that the image of \verb+middle a b+ is larger than the images of \verb+a+ and
\verb+b+ (take for instance the successor of the maximum of the two), and likewise
for a Cauchy sequence. A definition by induction works if the target cardinal is large
enough.

Then, pullback the well-order \verb+wo_aux+ by the map \verb+map_aux+: this gives a relation
that satisfies all the required properties, except that two different elements can be equal for
the order. Extending it essentially arbitrarily to distinguish between all elements (this is done
in Lemma \verb+Well_order_pullback+) gives the desired well-order›

definition Bonk_Schramm_extension_unfolded_wo where
  "Bonk_Schramm_extension_unfolded_wo = (SOME (r::'a Bonk_Schramm_extension_unfolded rel).
      well_order_on UNIV r
       (x  range basepoint. y  - range basepoint. (x, y)  r)
       ( a b. (a, middle a b)  r)
       ( a b. (b, middle a b)  r)
       ( u n. (u n, would_be_Cauchy u)  r))"

text ‹We prove the existence of the well order›

definition wo_aux where
  "wo_aux = (SOME (r:: (nat + 'a Bonk_Schramm_extension_unfolded set) rel).
      Card_order r  ¬finite(Field r)  regularCard r  |UNIV::'a Bonk_Schramm_extension_unfolded set| <o r)"

lemma wo_aux_exists:
  "Card_order wo_aux  ¬finite (Field wo_aux)  regularCard wo_aux  |UNIV::'a Bonk_Schramm_extension_unfolded set| <o wo_aux"
proof -
  have *: "r  {|UNIV::'a Bonk_Schramm_extension_unfolded set|}. Card_order r" by auto
  have **: "(r::(nat + 'a Bonk_Schramm_extension_unfolded set) rel).
    Card_order r  ¬finite(Field r)  regularCard r  ( |UNIV::'a Bonk_Schramm_extension_unfolded set| <o r)"
    by (metis card_of_card_order_on Field_card_of singletonI infinite_regularCard_exists[OF *])
  then show ?thesis unfolding wo_aux_def using someI_ex[OF **] by auto
qed

interpretation wo_aux: wo_rel wo_aux
  using wo_aux_exists Card_order_wo_rel by auto

primrec map_aux::"'a Bonk_Schramm_extension_unfolded  nat + 'a Bonk_Schramm_extension_unfolded set" where
  "map_aux (basepoint x) = wo_aux.zero"
  | "map_aux (middle a b) = wo_aux.suc ({map_aux a}  {map_aux b})"
  | "map_aux (would_be_Cauchy u) = wo_aux.suc ((map_aux o u)`UNIV)"

lemma map_aux_AboveS_not_empty:
  assumes "map_aux`S  Field wo_aux"
  shows "wo_aux.AboveS (map_aux`S)  {}"
apply (rule AboveS_not_empty_in_regularCard'[of S])
using wo_aux_exists assms apply auto
using card_of_UNIV ordLeq_ordLess_trans by blast

lemma map_aux_in_Field:
  "map_aux x  Field wo_aux"
proof (induction)
  case (basepoint x)
  have "wo_aux.zero  Field wo_aux"
    using Card_order_infinite_not_under wo_aux_exists under_empty wo_aux.zero_in_Field by fastforce
  then show ?case by auto
next
  case mid: (middle a b)
  have "({map_aux a}  {map_aux b})  Field wo_aux" using mid.IH by auto
  then have "wo_aux.AboveS ({map_aux a}  {map_aux b})  {}"
    using map_aux_AboveS_not_empty[of "{a}  {b}"] by auto
  then show ?case
    by (simp add: AboveS_Field wo_aux.suc_def)
next
  case cauchy: (would_be_Cauchy u)
  have "(map_aux o u)`UNIV  Field wo_aux" using cauchy.IH by auto
  then have "wo_aux.AboveS ((map_aux o u)`UNIV)  {}"
    using map_aux_AboveS_not_empty[of "u`(UNIV)"] by (simp add: image_image)
  then show ?case
    by (simp add: AboveS_Field wo_aux.suc_def)
qed

lemma middle_rel_a:
  "(map_aux a, map_aux (middle a b))  wo_aux - Id"
proof -
  have *: "({map_aux a}  {map_aux b})  Field wo_aux" using map_aux_in_Field by auto
  then have "wo_aux.AboveS ({map_aux a}  {map_aux b})  {}"
    using map_aux_AboveS_not_empty[of "{a}  {b}"] by auto
  then show ?thesis
    using * by (simp add: wo_aux.suc_greater Id_def)
qed

lemma middle_rel_b:
  "(map_aux b, map_aux (middle a b))  wo_aux - Id"
proof -
  have *: "({map_aux a}  {map_aux b})  Field wo_aux" using map_aux_in_Field by auto
  then have "wo_aux.AboveS ({map_aux a}  {map_aux b})  {}"
    using map_aux_AboveS_not_empty[of "{a}  {b}"] by auto
  then show ?thesis
    using * by (simp add: wo_aux.suc_greater Id_def)
qed

lemma cauchy_rel:
  "(map_aux (u n), map_aux (would_be_Cauchy u))  wo_aux - Id"
proof -
  have *: "(map_aux o u)`UNIV  Field wo_aux" using map_aux_in_Field by auto
  then have "wo_aux.AboveS ((map_aux o u)`UNIV)  {}"
    using map_aux_AboveS_not_empty[of "u`(UNIV)"] by (simp add: image_image)
  then show ?thesis
    using * by (simp add: wo_aux.suc_greater Id_def)
qed

text ‹From the above properties of \verb+wo_aux+, it follows using \verb+Well_order_pullback+
that an order satisfying all the properties we want of \verb+Bonk_Schramm_extension_unfolded_wo+
exists. Hence, we get the following lemma.›

lemma Bonk_Schramm_extension_unfolded_wo_props:
  "well_order_on UNIV Bonk_Schramm_extension_unfolded_wo"
  "x  range basepoint. y  - range basepoint. (x, y)  Bonk_Schramm_extension_unfolded_wo"
  " a b. (a, middle a b)  Bonk_Schramm_extension_unfolded_wo"
  " a b. (b, middle a b)  Bonk_Schramm_extension_unfolded_wo"
  "u n. (u n, would_be_Cauchy u)  Bonk_Schramm_extension_unfolded_wo"
proof -
  obtain r::"'a Bonk_Schramm_extension_unfolded rel" where r:
    "Well_order r"
    "Field r = UNIV"
    "x y. (map_aux x, map_aux y)  wo_aux - Id  (x, y)  r"
  using Well_order_pullback[of wo_aux map_aux] by (metis wo_aux.WELL)

  have "(x, y)  r" if "x  range basepoint" "y  - range basepoint" for x y
    apply (rule r(3)) using that
    apply (cases y)
      apply (auto cong del: image_cong_simp)
       apply (metis insert_is_Un map_aux.simps(2) map_aux_in_Field wo_aux.zero_smallest)
      apply (metis Diff_iff insert_is_Un wo_aux.leq_zero_imp map_aux.simps(2) middle_rel_a pair_in_Id_conv)
     apply (metis map_aux.simps(3) map_aux_in_Field wo_aux.zero_smallest)
    apply (metis Diff_iff cauchy_rel wo_aux.leq_zero_imp map_aux.simps(3) pair_in_Id_conv)
    done
  moreover have "(a, middle a b)  r" for a b
    apply (rule r(3)) using middle_rel_a by auto
  moreover have "(b, middle a b)  r" for a b
    apply (rule r(3)) using middle_rel_b by auto
  moreover have "(u n, would_be_Cauchy u)  r" for u n
    apply (rule r(3)) using cauchy_rel by auto
  moreover have "well_order_on UNIV r"
    using r(1) r(2) by auto
  ultimately have *: " (r::'a Bonk_Schramm_extension_unfolded rel).
      well_order_on UNIV r
       (x  range basepoint. y  - range basepoint. (x, y)  r)
       ( a b. (a, middle a b)  r)
       ( a b. (b, middle a b)  r)
       (u n. (u n, would_be_Cauchy u)  r)"
    by blast

  show
    "well_order_on UNIV Bonk_Schramm_extension_unfolded_wo"
    "x  range basepoint. y  - range basepoint. (x, y)  Bonk_Schramm_extension_unfolded_wo"
    " a b. (a, middle a b)  Bonk_Schramm_extension_unfolded_wo"
    " a b. (b, middle a b)  Bonk_Schramm_extension_unfolded_wo"
    "u n. (u n, would_be_Cauchy u)  Bonk_Schramm_extension_unfolded_wo"
  unfolding Bonk_Schramm_extension_unfolded_wo_def using someI_ex[OF *] by auto
qed

interpretation wo: wo_rel Bonk_Schramm_extension_unfolded_wo
  using well_order_on_Well_order wo_rel_def wfrec_def Bonk_Schramm_extension_unfolded_wo_props(1) by blast

text ‹We reformulate in the interpretation \verb+wo+ the main properties of
\verb+Bonk_Schramm_extension_unfolded_wo+ that we established in Lemma~\verb+Bonk_Schramm_extension_unfolded_wo_props+›

lemma Bonk_Schramm_extension_unfolded_wo_props':
  "a  wo.underS (middle a b)"
  "b  wo.underS (middle a b)"
  "u n  wo.underS (would_be_Cauchy u)"
proof -
  have "(a, middle a b)  Bonk_Schramm_extension_unfolded_wo"
    using Bonk_Schramm_extension_unfolded_wo_props(3) by auto
  then show "a  wo.underS (middle a b)"
    by (metis Diff_iff middle_rel_a pair_in_Id_conv underS_I)
  have "(b, middle a b)  Bonk_Schramm_extension_unfolded_wo"
    using Bonk_Schramm_extension_unfolded_wo_props(4) by auto
  then show "b  wo.underS (middle a b)"
    by (metis Diff_iff middle_rel_b pair_in_Id_conv underS_I)
  have "(u n, would_be_Cauchy u)  Bonk_Schramm_extension_unfolded_wo"
    using Bonk_Schramm_extension_unfolded_wo_props(5) by auto
  then show "u n  wo.underS (would_be_Cauchy u)"
    by (metis Diff_iff cauchy_rel pair_in_Id_conv underS_I)
qed

text ‹We want to define by transfinite induction a distance on \verb+'a Bonk_Schramm_extension_unfolded+,
adding one point at a time (i.e., if the distance is defined on $E$, then one wants to define it
on $E \cup \{x\}$, if $x$ is a middle or a potential Cauchy sequence, by prescribing the distance
from $x$ to all the points in $E$.

Technically, we define a family of distances, indexed by $x$, on $\{y : y \leq x\}^2$. As all
functions should be defined everywhere, this will be a family of functions on $X \times X$, indexed
by points in $X$. They will have a compatibility condition, making it possible to define a global
distance by gluing them together.

Technically, transfinite induction is implemented in Isabelle/HOL by an updating rule: a function
that associates, to a family of distances indexed by $x$, a new family of distances indexed by $x$.
The result of the transfinite induction is obtained by starting from an arbitrary object, and then
applying the updating rule infinitely many times. The characteristic property of the result of this
transfinite induction is that it is a fixed point of the updating rule, as it should.

Below, this is implemented as follows:
\begin{itemize}
\item \verb+extend_distance+ is the updating rule.
\item Its fixed point \verb+extend_distance_fp+ is by definition \verb+wo.worec extend_distance+
(it only makes sense if the udpating rule satisfies a compatibility condition
\verb+wo.adm_wo extend_distance+ saying that the update of a family, at $x$,
only depends on the value of the family
strictly below $x$.
\item Finally, the global distance \verb+extended_distance+ is taken as the
value of the fixed point above, on $x y y'$ (i.e., using the distance indexed by $x$) for any $x
\geq \max(y, y')$. For definiteness, we use $\max(y, y')$, but it does not matter as everything is
compatible.
\end{itemize}›

fun extend_distance::"('a Bonk_Schramm_extension_unfolded  ('a Bonk_Schramm_extension_unfolded  'a Bonk_Schramm_extension_unfolded  real))
                     ('a Bonk_Schramm_extension_unfolded  ('a Bonk_Schramm_extension_unfolded  'a Bonk_Schramm_extension_unfolded  real))"
  where
    "extend_distance f (basepoint x) = (λy z. if y  range basepoint  z  range basepoint then
        dist (SOME y'. y = basepoint y') (SOME z'. z = basepoint z') else 1)"
  | "extend_distance f (middle a b) = (λy z.
      if (y  wo.underS (middle a b))  (z  wo.underS (middle a b)) then f (wo.max2 y z) y z
      else if (y  wo.underS (middle a b))  (z = middle a b) then (f (wo.max2 a b) a b)/2 + (SUP w{z  wo.underS (middle a b). f z z z = 0}. f (wo.max2 y w) y w - max (f (wo.max2 a w) a w) (f (wo.max2 b w) b w))
      else if (y = middle a b)  (z  wo.underS (middle a b)) then (f (wo.max2 a b) a b)/2 + (SUP w{z  wo.underS (middle a b). f z z z = 0}. f (wo.max2 z w) z w - max (f (wo.max2 a w) a w) (f (wo.max2 b w) b w))
      else if (y = middle a b)  (z = middle a b)  (f a a a = 0)  (f b b b = 0) then 0
      else 1)"
  | "extend_distance f (would_be_Cauchy u) = (λy z.
      if (y  wo.underS (would_be_Cauchy u))  (z  wo.underS (would_be_Cauchy u)) then f (wo.max2 y z) y z
      else if (¬(eps > (0::real). N. n  N. m  N. f (wo.max2 (u n) (u m)) (u n) (u m) < eps)) then 1
      else if (y  wo.underS (would_be_Cauchy u))  (z = would_be_Cauchy u) then lim (λn. f (wo.max2 (u n) y) (u n) y)
      else if (y = would_be_Cauchy u)  (z  wo.underS (would_be_Cauchy u)) then lim (λn. f (wo.max2 (u n) z) (u n) z)
      else if (y = would_be_Cauchy u)  (z = would_be_Cauchy u)  (n. f (u n) (u n) (u n) = 0) then 0
      else 1)"

definition "extend_distance_fp = wo.worec extend_distance"

definition "extended_distance x y = extend_distance_fp (wo.max2 x y) x y"

definition "extended_distance_set = {z. extended_distance z z = 0}"

lemma wo_adm_extend_distance:
  "wo.adm_wo extend_distance"
unfolding wo.adm_wo_def proof (auto)
  fix f g::"'a Bonk_Schramm_extension_unfolded  'a Bonk_Schramm_extension_unfolded  'a Bonk_Schramm_extension_unfolded  real"
  fix x::"'a Bonk_Schramm_extension_unfolded"
  assume "ywo.underS x. f y = g y"
  then have *: "f y = g y" if "y  wo.underS x" for y using that by auto
  show "extend_distance f x = extend_distance g x"
    apply (cases x)
    (* We use the basic properties of our good order (middles and sequences come after their generators,
    and the fact that initial segments are stable under max2 *)
    apply (insert Bonk_Schramm_extension_unfolded_wo_props' *)
    apply auto
    (* Deal with the case of a middle, treating separately all the ifs *)
    apply (rule ext)+
    apply (rule if_cong, simp, simp)+ apply (rule SUP_cong, fastforce, blast)
    apply (rule if_cong, simp, simp)+ apply (rule SUP_cong, fastforce, blast)
    apply (rule if_cong, simp, simp)+ apply simp
    (* Deal with the case of a sequence, treating separately all the ifs *)
    apply (rule ext)+
    apply (rule if_cong, simp, simp)+
    apply simp
    done
qed

lemma extend_distance_fp:
  "extend_distance_fp = extend_distance (extend_distance_fp)"
using wo.worec_fixpoint[OF wo_adm_extend_distance] unfolding extend_distance_fp_def.

lemma extended_distance_symmetric:
  "extended_distance x y = extended_distance y x"
proof -
  have *: "extend_distance (extend_distance_fp) x x y = extend_distance (extend_distance_fp) x y x" if "y  wo.underS x" for x y
    apply (cases x)
    apply (simp add: that dist_commute)+
    by blast
  have **: "extended_distance x y = extended_distance y x" if "y  wo.underS x" for x y
    unfolding extended_distance_def using that *[OF that] extend_distance_fp by simp
  consider "y  wo.underS x"|"x  wo.underS y"|"x = y"
    by (metis UNIV_I Bonk_Schramm_extension_unfolded_wo_props(1) that(1) underS_I well_order_on_Well_order wo.TOTALS)
  then show ?thesis
    apply (cases) using ** by auto
qed

lemma extended_distance_basepoint:
  "extended_distance (basepoint x) (basepoint y) = dist x y"
proof -
  consider "wo.max2 (basepoint x) (basepoint y) = basepoint x" | "wo.max2 (basepoint x) (basepoint y) = basepoint y"
    by (meson wo.max2_def)
  then show ?thesis
    apply cases
    unfolding extended_distance_def by (subst extend_distance_fp, simp)+
qed

lemma extended_distance_set_basepoint:
  "basepoint x  extended_distance_set"
unfolding extended_distance_set_def using extended_distance_basepoint by auto

lemma extended_distance_set_middle:
  assumes "a  extended_distance_set" "b  extended_distance_set"
  shows "middle a b  extended_distance_set"
using assms unfolding extended_distance_set_def extended_distance_def apply auto
by (metis (no_types, lifting) extend_distance_fp extend_distance.simps(2) underS_E)

lemma extended_distance_set_middle':
  assumes "middle a b  extended_distance_set"
  shows "a  extended_distance_set  wo.underS (middle a b)"
        "b  extended_distance_set  wo.underS (middle a b)"
proof -
  have "extend_distance (extend_distance_fp) (middle a b) (middle a b) (middle a b) = 0"
    apply (subst extend_distance_fp[symmetric])
    using assms unfolding extended_distance_set_def extended_distance_def by simp
  then have "a  extended_distance_set" "b  extended_distance_set"
    unfolding extended_distance_set_def extended_distance_def apply auto
    by (metis zero_neq_one)+
  moreover have "a  wo.underS (middle a b)" "b  wo.underS (middle a b)"
    by (auto simp add: Bonk_Schramm_extension_unfolded_wo_props')
  ultimately show "a  extended_distance_set  wo.underS (middle a b)"
                  "b  extended_distance_set  wo.underS (middle a b)"
    by auto
qed

lemma extended_distance_middle_formula:
  assumes "x  wo.underS (middle a b)"
  shows "extended_distance x (middle a b) = (extended_distance a b)/2
    + (SUP wwo.underS (middle a b)  extended_distance_set.
          extended_distance x w - max (extended_distance a w) (extended_distance b w))"
unfolding extended_distance_set_def extended_distance_def
apply (subst extend_distance_fp)
apply (simp add: assms)
apply (rule SUP_cong)
apply (auto simp add: wo.max2_def)
done

lemma extended_distance_set_Cauchy:
  assumes "(would_be_Cauchy u)  extended_distance_set"
  shows "u n  extended_distance_set  wo.underS (would_be_Cauchy u)"
        "eps > (0::real). N. n  N. m  N. extended_distance (u n) (u m) < eps"
proof -
  have *: "extend_distance (extend_distance_fp) (would_be_Cauchy u) (would_be_Cauchy u) (would_be_Cauchy u) = 0"
    apply (subst extend_distance_fp[symmetric])
    using assms unfolding extended_distance_set_def extended_distance_def by simp
  then have "u n  extended_distance_set"
    unfolding extended_distance_set_def extended_distance_def apply auto
    by (metis (no_types, hide_lams) underS_notIn zero_neq_one)
  moreover have "u n  wo.underS (would_be_Cauchy u)"
    by (auto simp add: Bonk_Schramm_extension_unfolded_wo_props')
  ultimately show "u n  extended_distance_set  wo.underS (would_be_Cauchy u)"
    by auto
  show "eps > (0::real). N. n  N. m  N. extended_distance (u n) (u m) < eps"
    using * unfolding extended_distance_set_def extended_distance_def apply auto
    by (metis (no_types, hide_lams) zero_neq_one)
qed

lemma extended_distance_triang_ineq:
  assumes "x  extended_distance_set"
          "y  extended_distance_set"
          "z  extended_distance_set"
  shows "extended_distance x z  extended_distance x y + extended_distance y z"
proof -
  (* The proof of the triangular inequality is done by induction: one should show that adding
  a middle or a Cauchy sequence does not spoil the estimates. Technically, we show that the
  triangular inequality holds on all points under $t$, for all $t$, using a transfinite induction.
  The conclusion of the lemma then follows by using for $t$ the maximum of $x$, $y$, $z$.*)
  have ineq_rec: "x y z. x  wo.under t  extended_distance_set  y  wo.under t  extended_distance_set  z  wo.under t  extended_distance_set
       extended_distance x z  extended_distance x y + extended_distance y z" for t
  proof (rule wo.well_order_induct[of _ t])
    fix t
    assume IH_orig: "t2. t2  t  (t2, t)  Bonk_Schramm_extension_unfolded_wo 
               (x y z. x  wo.under t2  extended_distance_set 
                        y  wo.under t2  extended_distance_set 
                        z  wo.under t2  extended_distance_set 
                        extended_distance x z  extended_distance x y + extended_distance y z)"
    (*Reformulate the induction assumption in more convenient terms*)
    then have IH: "extended_distance x z  extended_distance x y + extended_distance y z"
      if "x  wo.underS t  extended_distance_set"
         "y  wo.underS t  extended_distance_set"
         "z  wo.underS t  extended_distance_set"
      for x y z
    proof -
      define t2 where "t2 = wo.max2 (wo.max2 x y) z"
      have "t2  wo.underS t" using that t2_def by auto
      have "x  wo.under t2" "y  wo.under t2" "z  wo.under t2" unfolding t2_def
        by (metis UNIV_I Bonk_Schramm_extension_unfolded_wo_props(1) mem_Collect_eq under_def well_order_on_Well_order wo.TOTALS wo.max2_iff)+
      then show ?thesis using that IH_orig t2  wo.underS t underS_E by fastforce
    qed

    have pos: "extended_distance x y  0" if "x  wo.underS t  extended_distance_set" "y  wo.underS t  extended_distance_set" for x y
    proof -
      have "0 = extended_distance x x" using that(1) extended_distance_set_def by auto
      also have "...  extended_distance x y + extended_distance y x"
        using IH that by auto
      also have "... = 2 * extended_distance x y"
        using extended_distance_symmetric by auto
      finally show ?thesis by auto
    qed

    (* The conclusion is easy if $t$ is not in \verb+extended_distance_set+, as there is no
    additional point to consider for the triangular inequality. The interesting case is when
    $t$ is admissible, then we will argue differently depending on its type.*)
    consider "t  extended_distance_set" | "t  extended_distance_set" by auto
    then show "x y z. x  wo.under t  extended_distance_set 
                  y  wo.under t  extended_distance_set 
                  z  wo.under t  extended_distance_set 
          extended_distance x z  extended_distance x y + extended_distance y z"
    proof (cases)
      case 1
      then have "wo.under t  extended_distance_set = wo.underS t  extended_distance_set"
        apply auto
        apply (metis mem_Collect_eq underS_I under_def)
        by (simp add: underS_E under_def)
      then show ?thesis using IH by auto
    next
      case 2
      (*We assume now that $t$ is admissible.
      We will prove now the triangular inequality for points under t, in the two basic cases
      where t is either the first point in the inequality, or the middle point.
      All other cases can be reduced to this one by permuting the variables, or they are
      trivial (if several variables are equal to t, for instance).*)
      have main_ineq: "extended_distance x z  extended_distance x t + extended_distance t z
                     extended_distance x t  extended_distance x z + extended_distance z t"
        if "x  wo.underS t  extended_distance_set"
           "z  wo.underS t  extended_distance_set"
        for x z
      proof (cases t)
        (*In the case of a basepoint, the distance comes from the original distance, hence
        it satisfies the triangular inequality*)
        case A: (basepoint t')
        then have "x  range basepoint" using Bonk_Schramm_extension_unfolded_wo_props(2)
          by (metis that(1) Compl_iff Int_iff range_eqI wo.max2_def wo.max2_underS'(2))
        then obtain x' where x: "x = basepoint x'" by auto
        have "z  range basepoint" using Bonk_Schramm_extension_unfolded_wo_props(2) A
          by (metis that(2) Compl_iff Int_iff range_eqI wo.max2_def wo.max2_underS'(2))
        then obtain z' where z: "z = basepoint z'" by auto
        show "extended_distance x z  extended_distance x t + extended_distance t z
             extended_distance x t  extended_distance x z + extended_distance z t"
          unfolding x z A extended_distance_basepoint by (simp add: dist_triangle)
      next
        (*In the case of a middle, the triangular inequality follows from the specific formula
        devised by Bonk and Schramm and (not very complicated) computations. The only mild difficulty
        is that the formula is defined in terms of a supremum, so one should check that this
        supremum is taken over a bounded set. This boundedness comes from the triangular inequality
        for point strictly below $t$, i.e., our inductive assumption.*)
        case M: (middle a b)
        then have ab: "a  extended_distance_set  wo.underS (middle a b)"
                      "b  extended_distance_set  wo.underS (middle a b)"
          using 2 extended_distance_set_middle'[of a b] by auto
        have dxt: "extended_distance x t = (extended_distance a b)/2
          + (SUP wwo.underS (middle a b)  extended_distance_set.
              extended_distance x w - max (extended_distance a w) (extended_distance b w))"
          using that(1) unfolding M using extended_distance_middle_formula by auto
        have dzt: "extended_distance z t = (extended_distance a b)/2
            + (SUP wwo.underS (middle a b)  extended_distance_set.
              extended_distance z w - max (extended_distance a w) (extended_distance b w))"
          using that(2) unfolding M using extended_distance_middle_formula by auto

        have bdd: "bdd_above ((λw. extended_distance x w - max (extended_distance a w) (extended_distance b w))` (wo.underS (middle a b)  extended_distance_set))"
          if "x  wo.underS t  extended_distance_set" for x
        proof (rule bdd_aboveI2)
          fix w assume w: "w  wo.underS (middle a b)  extended_distance_set"
          have "extended_distance x w  extended_distance x a + extended_distance a w"
            apply (rule IH) using ab w M that(1) by auto
          also have "...  extended_distance x a + max (extended_distance a w) (extended_distance b w)"
            by auto
          finally show "extended_distance x w - max (extended_distance a w) (extended_distance b w)
                         extended_distance x a"
            by auto
        qed

        have "(λw. extended_distance x z + extended_distance z w - max (extended_distance a w) (extended_distance b w)) ` (underS Bonk_Schramm_extension_unfolded_wo (middle a b)  extended_distance_set)
            = (λs. s + extended_distance x z)` (λw. extended_distance z w - max (extended_distance a w) (extended_distance b w)) ` (underS Bonk_Schramm_extension_unfolded_wo (middle a b)  extended_distance_set)"
          by auto
        moreover have "bdd_above ((λs. s + extended_distance x z)` (λw. extended_distance z w - max (extended_distance a w) (extended_distance b w)) ` (underS Bonk_Schramm_extension_unfolded_wo (middle a b)  extended_distance_set))"
          apply (rule bdd_above_image_mono) using bdd that by (auto simp add: mono_def)
        ultimately have bdd_3: "bdd_above ((λw. extended_distance x z + extended_distance z w - max (extended_distance a w) (extended_distance b w)) ` (underS Bonk_Schramm_extension_unfolded_wo (middle a b)  extended_distance_set))"
          by simp

        have **: "max (extended_distance a a) (extended_distance b a) = extended_distance b a"
          apply (rule max_absorb2) using pos ab extended_distance_set_def M by auto
        then have "-extended_distance a b / 2 + extended_distance x a
              = (extended_distance a b)/2 + extended_distance x a - max (extended_distance a a) (extended_distance b a)"
          unfolding extended_distance_symmetric[of a b] by auto
        also have "...  extended_distance x t"
          unfolding dxt apply (simp, rule cSUP_upper, simp) using bdd that M ab by auto
        finally have D1: "-extended_distance a b / 2 + extended_distance x a  extended_distance x t"
          by simp

        have **: "max (extended_distance a b) (extended_distance b b) = extended_distance a b"
          apply (rule max_absorb1) using pos ab extended_distance_set_def M by auto
        then have "-extended_distance a b / 2 + extended_distance x b
              = (extended_distance a b)/2 + extended_distance x b - max (extended_distance a b) (extended_distance b b)"
          unfolding extended_distance_symmetric[of a b] by auto
        also have "...  extended_distance x t"
          unfolding dxt apply (simp, rule cSUP_upper, simp) using bdd that ab by auto
        finally have "-extended_distance a b / 2 + extended_distance x b  extended_distance x t"
          by simp
        then have D2: "-extended_distance a b / 2 + max (extended_distance x a) (extended_distance x b)  extended_distance x t"
          using D1 by auto

        have "extended_distance x z = (-extended_distance a b / 2 + max (extended_distance x a) (extended_distance x b)) +
                      (extended_distance a b / 2 + extended_distance x z - max (extended_distance x a) (extended_distance x b))"
          by auto
        also have "...  extended_distance x t +
                      (extended_distance a b / 2 + extended_distance z x - max (extended_distance a x) (extended_distance b x))"
          using D2 extended_distance_symmetric by auto
        also have "...  extended_distance x t + extended_distance z t"
          unfolding dzt apply (simp, rule cSUP_upper) using bdd that M ab by auto
        finally have I: "extended_distance x z  extended_distance x t + extended_distance z t"
          using extended_distance_symmetric by auto

        have T: "underS Bonk_Schramm_extension_unfolded_wo (middle a b)  extended_distance_set  {}"
                "mono ((+) (extended_distance x z))"
                "bij ((+) (extended_distance x z))"
          using ab(1) apply blast
          by (simp add: monoI, rule bij_betw_byWitness[of _ "λs. s - (extended_distance x z)"], auto)
        have "extended_distance x t  (extended_distance a b)/2
          + (SUP wwo.underS (middle a b)  extended_distance_set.
              extended_distance x z + extended_distance z w - max (extended_distance a w) (extended_distance b w))"
          unfolding dxt apply (simp, rule cSUP_subset_mono)
          using M that IH bdd_3 by (auto)
        also have "... = extended_distance x z + extended_distance z t"
          unfolding dzt apply simp
          using mono_cSup_bij[of "(λw. extended_distance z w - max (extended_distance a w) (extended_distance b w))`(wo.underS (middle a b)  extended_distance_set)" "λs. extended_distance x z + s", OF _ _ T(2) T(3)]
          by (auto simp add: bdd [OF that(2)] ab(1) T(1) add_diff_eq image_comp)
        finally have "extended_distance x t  extended_distance x z + extended_distance z t" by simp
        then show "extended_distance x z  extended_distance x t + extended_distance t z
                   extended_distance x t  extended_distance x z + extended_distance z t"
          using I extended_distance_symmetric by auto
      next
        (*For Cauchy sequences, the distance to the Cauchy sequence is the limit of the distances
        to terms of the sequence, hence the triangular inequality follows from the triangular inequality
        for points strictly below $t$ by passing to the limit.*)
        case C: (would_be_Cauchy u)
        then have un: "u n  extended_distance_set  wo.underS (would_be_Cauchy u)" for n
          using extended_distance_set_Cauchy 2 by auto
        have lim: "(λn. extended_distance y (u n))  (extended_distance y (would_be_Cauchy u))"
            if y: "y  extended_distance_set  wo.underS (would_be_Cauchy u)" for y
        proof -
          have "extend_distance extend_distance_fp (wo.max2 (would_be_Cauchy u) (would_be_Cauchy u)) (would_be_Cauchy u) (would_be_Cauchy u) = 0"
            using 2 unfolding C extended_distance_set_def extended_distance_def
            using extend_distance_fp by auto
          then have cauch: "N. n  N. m  N. extend_distance_fp (wo.max2 (u n) (u m)) (u n) (u m) < e" if "e > 0" for e
            apply auto using e > 0 by (metis (no_types, hide_lams) zero_neq_one)
          have "N. n  N. m  N. abs(extended_distance y (u n) - extended_distance y (u m)) < e" if "e > 0" for e
          proof -
            obtain N where *: "extend_distance_fp (wo.max2 (u n) (u m)) (u n) (u m) < e" if "n  N" "m  N" for m n
              using cauch by (meson 0 < e)
            {
              fix m n assume "m  N" "n  N"
              then have e: "extended_distance (u n) (u m) < e" using * unfolding extended_distance_def by auto
              have "extended_distance y (u n)  extended_distance y (u m) + extended_distance (u m) (u n)"
                using IH y un C by blast
              then have 1: "extended_distance y (u n) - extended_distance y (u m) < e"
                using e extended_distance_symmetric by auto
              have "extended_distance y (u m)  extended_distance y (u n) + extended_distance (u n) (u m)"
                using IH y un C by blast
              then have "extended_distance y (u m) - extended_distance y (u n) < e"
                using e extended_distance_symmetric by auto
              then have "abs(extended_distance y (u n) - extended_distance y (u m)) < e"
                using 1 by auto
            }
            then show ?thesis by auto
          qed
          then have "convergent (λn. extended_distance y (u n))"
            by (simp add: Cauchy_iff real_Cauchy_convergent)
          then have lim: "(λn. extended_distance y (u n))  lim (λn. extended_distance y (u n))"
            using convergent_LIMSEQ_iff by auto
          have *: "wo.max2 y (would_be_Cauchy u) = would_be_Cauchy u" "y  would_be_Cauchy u" using y by auto
          have "extended_distance y (would_be_Cauchy u) = lim (λn. extended_distance (u n) y)"
            unfolding extended_distance_def apply (subst extend_distance_fp) unfolding *
            using *(2) y cauch by auto
          then show "(λn. extended_distance y (u n))  extended_distance y (would_be_Cauchy u)"
            using lim extended_distance_symmetric by auto
        qed
        have "extended_distance x z  extended_distance x (u n) + extended_distance (u n) z" for n
          using IH un that C by auto
        moreover have "(λn. extended_distance x (u n) + extended_distance (u n) z)  extended_distance x t + extended_distance t z"
          apply (auto intro!: tendsto_add)
          using lim that extended_distance_symmetric unfolding C by auto
        ultimately have I: "extended_distance x z  extended_distance x t + extended_distance t z"
          using LIMSEQ_le_const by blast

        have "extended_distance x (u n)  extended_distance x z + extended_distance z (u n)" for n
          using IH un that C by auto
        moreover have "(λn. extended_distance x (u n))  extended_distance x t"
          using lim that extended_distance_symmetric unfolding C by auto
        moreover have "(λn. extended_distance x z + extended_distance z (u n))  extended_distance x z + extended_distance z t"
          apply (auto intro!: tendsto_add)
          using lim that extended_distance_symmetric unfolding C by auto
        ultimately have "extended_distance x t  extended_distance x z + extended_distance z t"
          using LIMSEQ_le by blast
        then show "extended_distance x z  extended_distance x t + extended_distance t z
                   extended_distance x t  extended_distance x z + extended_distance z t"
          using I by auto
      qed

      (* Now, we deduce (from the above bounds in specific cases) the general triangular inequality,
      by considering separately if each point is equal to $t$ or strictly under it.*)
      {
        fix x y z assume H: "x  wo.under t  extended_distance_set"
                            "y  wo.under t  extended_distance_set"
                            "z  wo.under t  extended_distance_set"
        have t: "extended_distance t t = 0" "extended_distance t t  0" using 2 extended_distance_set_def by auto
        have *: "((x  wo.underS t  extended_distance_set)  (x = t))
             ((y  wo.underS t  extended_distance_set)  (y = t))
             ((z  wo.underS t  extended_distance_set)  (z = t))"
          using H by (simp add: underS_def under_def)
        have "extended_distance x z  extended_distance x y + extended_distance y z"
          using * apply auto
          using t main_ineq extended_distance_symmetric IH pos apply blast
          using t main_ineq extended_distance_symmetric IH pos apply blast
          using t main_ineq extended_distance_symmetric IH pos apply blast
          using t main_ineq extended_distance_symmetric IH pos apply blast
          using t main_ineq extended_distance_symmetric IH pos apply (metis * Int_commute add.commute underS_notIn)
          using t main_ineq extended_distance_symmetric IH pos apply (metis (mono_tags, lifting) "*" extended_distance_set_def mem_Collect_eq underS_notIn)
          using t by auto
      }
      then show ?thesis by auto
    qed
  qed (*End of the inductive proof*)

  define t where "t = wo.max2 (wo.max2 x y) z"
  have "x  wo.under t" "y  wo.under t" "z  wo.under t"
    unfolding t_def
    by (metis UNIV_I Bonk_Schramm_extension_unfolded_wo_props(1) mem_Collect_eq under_def well_order_on_Well_order wo.max2_equals1 wo.max2_iff wo.max2_xx)+
  then show ?thesis using assms ineq_rec by auto
qed

text ‹We can now show the two main properties of the construction: the middle is indeed a middle
from the metric point of view (in \verb+extended_distance_middle+), and Cauchy sequences have
a limit (the corresponding \verb+would_be_Cauchy+ point).›

lemma extended_distance_pos:
  assumes "a  extended_distance_set"
          "b  extended_distance_set"
  shows "extended_distance a b  0"
using assms extended_distance_set_def extended_distance_triang_ineq[of a b a]
unfolding extended_distance_symmetric[of b a] by auto

lemma extended_distance_middle:
  assumes "a  extended_distance_set"
          "b  extended_distance_set"
  shows "extended_distance a (middle a b) = extended_distance a b / 2"
        "extended_distance b (middle a b) = extended_distance a b / 2"
proof -
  have "0 = extended_distance a b - max (extended_distance a b) (extended_distance b b)"
    using extended_distance_pos[OF assms] assms(2) extended_distance_set_def by auto
  also have "...  (SUP wwo.underS (middle a b)  extended_distance_set.
          extended_distance a w - max (extended_distance a w) (extended_distance b w))"
    apply (rule cSUP_upper)
    apply (simp add: assms(2) Bonk_Schramm_extension_unfolded_wo_props'(2))
    by (rule bdd_aboveI2[of _ _ 0], auto)
  ultimately have "0  (SUP wwo.underS (middle a b)  extended_distance_set.
          extended_distance a w - max (extended_distance a w) (extended_distance b w))"
    by auto
  moreover have "(SUP wwo.underS (middle a b)  extended_distance_set.
          extended_distance a w - max (extended_distance a w) (extended_distance b w))  0"
    apply (rule cSUP_least)
    using assms(1) Bonk_Schramm_extension_unfolded_wo_props'(1) by (fastforce, auto)
  moreover have "extended_distance a (middle a b) = (extended_distance a b)/2
    + (SUP wwo.underS (middle a b)  extended_distance_set.
          extended_distance a w - max (extended_distance a w) (extended_distance b w))"
    by (rule extended_distance_middle_formula, simp add: Bonk_Schramm_extension_unfolded_wo_props'(1))
  ultimately show "extended_distance a (middle a b) = (extended_distance a b)/2"
    by auto

  have "0 = extended_distance b a - max (extended_distance a a) (extended_distance b a)"
    using extended_distance_pos[OF assms] assms(1) extended_distance_set_def extended_distance_symmetric by auto
  also have "...  (SUP wwo.underS (middle a b)  extended_distance_set.
          extended_distance b w - max (extended_distance a w) (extended_distance b w))"
    apply (rule cSUP_upper)
    apply (simp add: assms(1) Bonk_Schramm_extension_unfolded_wo_props'(1))
    by (rule bdd_aboveI2[of _ _ 0], auto)
  ultimately have "0  (SUP wwo.underS (middle a b)  extended_distance_set.
          extended_distance b w - max (extended_distance a w) (extended_distance b w))"
    by auto
  moreover have "(SUP wwo.underS (middle a b)  extended_distance_set.
          extended_distance b w - max (extended_distance a w) (extended_distance b w))  0"
    apply (rule cSUP_least)
    using assms(1) Bonk_Schramm_extension_unfolded_wo_props'(1) by (fastforce, auto)
  moreover have "extended_distance b (middle a b) = (extended_distance a b)/2
    + (SUP wwo.underS (middle a b)  extended_distance_set.
          extended_distance b w - max (extended_distance a w) (extended_distance b w))"
    by (rule extended_distance_middle_formula, simp add: Bonk_Schramm_extension_unfolded_wo_props'(2))
  ultimately show "extended_distance b (middle a b) = (extended_distance a b)/2"
    by auto
qed

lemma extended_distance_Cauchy:
  assumes "(n::nat). u n  extended_distance_set"
      and "eps > (0::real). N. n  N. m  N. extended_distance (u n) (u m) < eps"
  shows "would_be_Cauchy u  extended_distance_set"
        "(λn. extended_distance (u n) (would_be_Cauchy u))  0"
proof -
  show 2: "would_be_Cauchy u  extended_distance_set"
    unfolding extended_distance_set_def extended_distance_def apply (simp, subst extend_distance_fp)
    using assms unfolding extended_distance_set_def extended_distance_def by simp

  have lim: "(λn. extended_distance y (u n))  (extended_distance y (would_be_Cauchy u))"
      if y: "y  extended_distance_set  wo.underS (would_be_Cauchy u)" for y
  proof -
    have "N. n  N. m  N. abs(extended_distance y (u n) - extended_distance y (u m)) < e" if "e > 0" for e
    proof -
      obtain N where *: "extended_distance (u n) (u m) < e" if "n  N" "m  N" for m n
        using assms(2) that e > 0 by meson
      {
        fix m n assume "m  N" "n  N"
        then have e: "extended_distance (u n) (u m) < e" using * by auto
        have "extended_distance y (u n)  extended_distance y (u m) + extended_distance (u m) (u n)"
          using extended_distance_triang_ineq y assms(1) by blast
        then have 1: "extended_distance y (u n) - extended_distance y (u m) < e"
          using e extended_distance_symmetric by auto
        have "extended_distance y (u m)  extended_distance y (u n) + extended_distance (u n) (u m)"
          using extended_distance_triang_ineq y assms(1) by blast
        then have "extended_distance y (u m) - extended_distance y (u n) < e"
          using e extended_distance_symmetric by auto
        then have "abs(extended_distance y (u n) - extended_distance y (u m)) < e"
          using 1 by auto
      }
      then show ?thesis by auto
    qed
    then have "convergent (λn. extended_distance y (u n))"
      by (simp add: Cauchy_iff real_Cauchy_convergent)
    then have lim: "(λn. extended_distance y (u n))  lim (λn. extended_distance y (u n))"
      using convergent_LIMSEQ_iff by auto
    have *: "wo.max2 y (would_be_Cauchy u) = would_be_Cauchy u" "y  would_be_Cauchy u" using y by auto
    have "extended_distance y (would_be_Cauchy u) = lim (λn. extended_distance (u n) y)"
      unfolding extended_distance_def apply (subst extend_distance_fp) unfolding *
      using *(2) y assms(2) extended_distance_def by auto
    then show "(λn. extended_distance y (u n))  extended_distance y (would_be_Cauchy u)"
      using lim extended_distance_symmetric by auto
  qed

  have "N. n  N. abs(extended_distance (u n) (would_be_Cauchy u)) < e" if "e > 0" for e
  proof -
    obtain N where *: "extended_distance (u n) (u m) < e/2" if "n  N" "m  N" for m n
      using assms(2) that e > 0 by (meson half_gt_zero)
    have "abs(extended_distance (u n) (would_be_Cauchy u))  e/2" if "n  N" for n
    proof -
      have "eventually (λm. extended_distance (u n) (u m)  e/2) sequentially"
        apply (rule eventually_sequentiallyI[of N]) using *[OF n  N] less_imp_le by auto
      moreover have "(λm. extended_distance (u n) (u m))  extended_distance (u n) (would_be_Cauchy u)"
        apply (rule lim) using "2" extended_distance_set_Cauchy by auto
      ultimately have "extended_distance (u n) (would_be_Cauchy u)  e/2"
        by (meson "*" LIMSEQ_le_const2 less_imp_le that)
      then show ?thesis using extended_distance_pos[OF assms(1)[of n] 2] by auto
    qed
    then show ?thesis using e > 0 by force
  qed
  then show "(λn. extended_distance (u n) (would_be_Cauchy u))  0"
    using LIMSEQ_iff by force
qed

end (* of context \verb+metric_space+ *)


subsection ‹The Bonk Schramm extension›

quotient_type (overloaded) 'a Bonk_Schramm_extension =
  "('a::metric_space) Bonk_Schramm_extension_unfolded"
  / partial: "λx y. (x  extended_distance_set  y  extended_distance_set  extended_distance x y = 0)"
unfolding part_equivp_def proof(auto intro!: ext simp: extended_distance_set_def)
  show "x. extended_distance x x = 0"
    using extended_distance_set_basepoint extended_distance_set_def by auto
next
  fix x y z::"'a Bonk_Schramm_extension_unfolded"
  assume H: "extended_distance x x = 0" "extended_distance y y = 0" "extended_distance z z = 0"
            "extended_distance x y = 0" "extended_distance x z = 0"
  have "extended_distance y z  extended_distance y x + extended_distance x z"
    apply (rule extended_distance_triang_ineq)
    using H unfolding extended_distance_set_def by auto
  also have "...  0"
    by (auto simp add: extended_distance_symmetric H)
  finally show "extended_distance y z = 0"
    using extended_distance_pos[of y z] H unfolding extended_distance_set_def by auto
next
  fix x y z::"'a Bonk_Schramm_extension_unfolded"
  assume H: "extended_distance x x = 0" "extended_distance y y = 0" "extended_distance z z = 0"
            "extended_distance x y = 0" "extended_distance y z = 0"
  have "extended_distance x z  extended_distance x y + extended_distance y z"
    apply (rule extended_distance_triang_ineq)
    using H unfolding extended_distance_set_def by auto
  also have "...  0"
    by (auto simp add: extended_distance_symmetric H)
  finally show "extended_distance x z = 0"
    using extended_distance_pos[of x z] H unfolding extended_distance_set_def by auto
qed (metis)


instantiation Bonk_Schramm_extension :: (metric_space) metric_space
begin

lift_definition dist_Bonk_Schramm_extension::"('a::metric_space) Bonk_Schramm_extension  'a Bonk_Schramm_extension  real"
  is "λx y. extended_distance x y"
proof -
  fix x y z t::"'a Bonk_Schramm_extension_unfolded"
  assume H: "x  extended_distance_set  y  extended_distance_set  extended_distance x y = 0"
            "z  extended_distance_set  t  extended_distance_set  extended_distance z t = 0"
  have "extended_distance x z  extended_distance x y + extended_distance y t + extended_distance t z"
    using extended_distance_triang_ineq[of x y z] extended_distance_triang_ineq[of y t z] H
    by auto
  also have "... = extended_distance y t"
    using H by (auto simp add: extended_distance_symmetric)
  finally have *: "extended_distance x z  extended_distance y t" by simp
  have "extended_distance y t  extended_distance y x + extended_distance x z + extended_distance z t"
    using extended_distance_triang_ineq[of y x t] extended_distance_triang_ineq[of x z t] H
    by auto
  also have "... = extended_distance x z"
    using H by (auto simp add: extended_distance_symmetric)
  finally show "extended_distance x z = extended_distance y t" using * by simp
qed

text ‹To define a metric space in the current library of Isabelle/HOL, one should also introduce
a uniformity structure and a topology, as follows (they are prescribed by the distance):›

definition uniformity_Bonk_Schramm_extension::"(('a Bonk_Schramm_extension) × ('a Bonk_Schramm_extension)) filter"
  where "uniformity_Bonk_Schramm_extension = (INF e{0 <..}. principal {(x, y). dist x y < e})"

definition open_Bonk_Schramm_extension :: "'a Bonk_Schramm_extension set  bool"
  where "open_Bonk_Schramm_extension U = (xU. eventually (λ(x', y). x' = x  y  U) uniformity)"

instance proof
  fix x y::"'a Bonk_Schramm_extension"
  have C: "rep_Bonk_Schramm_extension x  extended_distance_set"
          "rep_Bonk_Schramm_extension y  extended_distance_set"
    using Quotient3_Bonk_Schramm_extension Quotient3_rep_reflp by fastforce+
  show "(dist x y = 0) = (x = y)"
    apply (subst Quotient3_rel_rep[OF Quotient3_Bonk_Schramm_extension, symmetric])
    unfolding dist_Bonk_Schramm_extension_def using C by auto
next
  fix x y z::"'a Bonk_Schramm_extension"
  have C: "rep_Bonk_Schramm_extension x  extended_distance_set"
          "rep_Bonk_Schramm_extension y  extended_distance_set"
          "rep_Bonk_Schramm_extension z  extended_distance_set"
    using Quotient3_Bonk_Schramm_extension Quotient3_rep_reflp by fastforce+
  show "dist x y  dist x z + dist y z"
    unfolding dist_Bonk_Schramm_extension_def apply auto
    by (metis C extended_distance_symmetric extended_distance_triang_ineq)
qed (auto simp add: uniformity_Bonk_Schramm_extension_def open_Bonk_Schramm_extension_def)
end

instance Bonk_Schramm_extension :: (metric_space) complete_space
proof
  fix X::"nat  'a Bonk_Schramm_extension" assume "Cauchy X"
  have *: "n. rep_Bonk_Schramm_extension (X n)  extended_distance_set"
    using Quotient3_Bonk_Schramm_extension Quotient3_rep_reflp by fastforce
  have **: "extended_distance (rep_Bonk_Schramm_extension (X n)) (rep_Bonk_Schramm_extension (X m)) = dist (X n) (X m)" for m n
    unfolding dist_Bonk_Schramm_extension_def by auto
  define y where "y = would_be_Cauchy (λn. rep_Bonk_Schramm_extension (X n))"
  have "y  extended_distance_set"
    unfolding y_def apply (rule extended_distance_Cauchy)
    using * ‹Cauchy X unfolding Cauchy_def **[symmetric] by auto
  define x where "x = abs_Bonk_Schramm_extension y"
  have "dist (X n) x = extended_distance (rep_Bonk_Schramm_extension (X n)) y" for n
    unfolding x_def apply (subst Quotient3_abs_rep[OF Quotient3_Bonk_Schramm_extension, symmetric])
    apply (rule dist_Bonk_Schramm_extension.abs_eq) using * y  extended_distance_set›
    by (auto simp add: extended_distance_set_def)
  moreover have "(λn. extended_distance (rep_Bonk_Schramm_extension (X n)) y)  0"
    unfolding y_def apply (rule extended_distance_Cauchy)
    using * ‹Cauchy X unfolding Cauchy_def **[symmetric] by auto
  ultimately have *: "(λn. dist (X n) x)  0" by simp
  have "X  x"
    apply (rule tendstoI) using * by (auto simp add: order_tendsto_iff)
  then show "convergent X" unfolding convergent_def by auto
qed

instance Bonk_Schramm_extension :: (metric_space) geodesic_space
proof (rule complete_with_middles_imp_geodesic)
  fix x y::"'a Bonk_Schramm_extension"
  have H: "rep_Bonk_Schramm_extension x  extended_distance_set"
          "rep_Bonk_Schramm_extension y  extended_distance_set"
    using Quotient3_Bonk_Schramm_extension Quotient3_rep_reflp by fastforce+
  define M where "M = middle (rep_Bonk_Schramm_extension x) (rep_Bonk_Schramm_extension y)"
  then have M: "M  extended_distance_set"
    using extended_distance_set_middle[OF H] by simp
  define m where "m = abs_Bonk_Schramm_extension M"

  have "dist x m = extended_distance (rep_Bonk_Schramm_extension x) M"
    apply (subst Quotient3_abs_rep[OF Quotient3_Bonk_Schramm_extension, symmetric]) unfolding m_def
    apply (rule dist_Bonk_Schramm_extension.abs_eq)
    using H M extended_distance_set_def by auto
  also have "... = extended_distance (rep_Bonk_Schramm_extension x) (rep_Bonk_Schramm_extension y) / 2"
    unfolding M_def by (rule extended_distance_middle[OF H])
  also have "... = dist x y / 2"
    unfolding dist_Bonk_Schramm_extension_def by auto
  finally have *: "dist x m = dist x y / 2" by simp

  have "dist m y = extended_distance M (rep_Bonk_Schramm_extension y)"
    apply (subst Quotient3_abs_rep[OF Quotient3_Bonk_Schramm_extension, of y, symmetric]) unfolding m_def
    apply (rule dist_Bonk_Schramm_extension.abs_eq)
    using H M extended_distance_set_def by auto
  also have "... = extended_distance (rep_Bonk_Schramm_extension x) (rep_Bonk_Schramm_extension y) / 2"
    unfolding M_def using extended_distance_middle(2)[OF H] by (simp add: extended_distance_symmetric)
  also have "... = dist x y / 2"
    unfolding dist_Bonk_Schramm_extension_def by auto
  finally have "dist m y = dist x y / 2" by simp
  then show "m. dist x m = dist x y / 2  dist m y = dist x y / 2"
    using * by auto
qed

definition to_Bonk_Schramm_extension::"'a::metric_space  'a Bonk_Schramm_extension"
  where "to_Bonk_Schramm_extension x = abs_Bonk_Schramm_extension (basepoint x)"

lemma to_Bonk_Schramm_extension_isometry:
  "isometry_on UNIV to_Bonk_Schramm_extension"
proof (rule isometry_onI)
  fix x y::'a
  show "dist (to_Bonk_Schramm_extension x) (to_Bonk_Schramm_extension y) = dist x y"
    unfolding to_Bonk_Schramm_extension_def apply (subst dist_Bonk_Schramm_extension.abs_eq)
    unfolding extended_distance_set_def by (auto simp add: extended_distance_basepoint)
qed


section ‹Bonk-Schramm extension of hyperbolic spaces›

subsection ‹The Bonk-Schramm extension preserves hyperbolicity›

text ‹A central feature of the Bonk-Schramm extension is that it preserves hyperbolicity, with the
same hyperbolicity constant $\delta$, as we prove now.›

lemma (in Gromov_hyperbolic_space) Bonk_Schramm_extension_unfolded_hyperbolic:
  fixes x y z t::"('a::metric_space) Bonk_Schramm_extension_unfolded"
  assumes "x  extended_distance_set"
          "y  extended_distance_set"
          "z  extended_distance_set"
          "t  extended_distance_set"
  shows "extended_distance x y + extended_distance z t  max (extended_distance x z + extended_distance y t) (extended_distance x t + extended_distance y z) + 2 * deltaG(TYPE('a))"
proof -
  interpret wo: wo_rel Bonk_Schramm_extension_unfolded_wo
  using well_order_on_Well_order wo_rel_def wfrec_def metric_space_class.Bonk_Schramm_extension_unfolded_wo_props(1) by blast

  (*To prove the hyperbolicity inequality, we prove it on larger and larger sets, by induction, adding
  one point $a$ at a time. Then the result will follow readily.*)
  have ineq_rec: "x y z t. x  wo.under a  extended_distance_set  y  wo.under a  extended_distance_set  z  wo.under a  extended_distance_set  t  wo.under a  extended_distance_set
       extended_distance x y + extended_distance z t  max (extended_distance x z + extended_distance y t) (extended_distance x t + extended_distance y z) + 2 * deltaG(TYPE('a))"
    for a::"'a Bonk_Schramm_extension_unfolded"
  proof (rule wo.well_order_induct[of _ a])
    fix a::"'a Bonk_Schramm_extension_unfolded"
    assume IH_orig: "b. b  a  (b, a)  Bonk_Schramm_extension_unfolded_wo 
               (x y z t. x  wo.under b  extended_distance_set 
                          y  wo.under b  extended_distance_set 
                          z  wo.under b  extended_distance_set 
                          t  wo.under b  extended_distance_set 
      extended_distance x y + extended_distance z t  max (extended_distance x z + extended_distance y t) (extended_distance x t + extended_distance y z) + 2 * deltaG(TYPE('a)))"
    (*Reformulate the induction assumption in more convenient terms*)
    then have IH: "extended_distance x y + extended_distance z t  max (extended_distance x z + extended_distance y t) (extended_distance x t + extended_distance y z) + 2 * deltaG(TYPE('a))"
      if "x  wo.underS a  extended_distance_set"
         "y  wo.underS a  extended_distance_set"
         "z  wo.underS a  extended_distance_set"
         "t  wo.underS a  extended_distance_set"
      for x y z t
    proof -
      define b where "b = wo.max2 (wo.max2 x y) (wo.max2 z t)"
      have "b  wo.underS a" using that b_def by auto
      have "x  wo.under b" "y  wo.under b" "z  wo.under b" "t  wo.under b" unfolding b_def
        apply (auto simp add: under_def)
        by (metis UNIV_I metric_space_class.Bonk_Schramm_extension_unfolded_wo_props(1) mem_Collect_eq under_def well_order_on_Well_order wo.TOTALS wo.max2_iff)+
      then show ?thesis using that IH_orig b  wo.underS a underS_E by fastforce
    qed

    consider "a  extended_distance_set" | "a  extended_distance_set" by auto
    then show "x y z t. x  wo.under a  extended_distance_set 
                          y  wo.under a  extended_distance_set 
                          z  wo.under a  extended_distance_set 
                          t  wo.under a  extended_distance_set 
      extended_distance x y + extended_distance z t  max (extended_distance x z + extended_distance y t) (extended_distance x t + extended_distance y z) + 2 * deltaG(TYPE('a))"
    proof (cases)
      (* If the point $a$ is not admissible for the distance, then we are not adding any point,
      and the result follows readily from the assumption hypothesis.*)
      case 1
      then have "wo.under a  extended_distance_set = wo.underS a  extended_distance_set"
        apply auto
        apply (metis mem_Collect_eq underS_I under_def)
        by (simp add: underS_E under_def)
      then show ?thesis using IH by auto
    next
      (*Now, we assume that the point $a$ is admissible. We will first check the desired
      inequality when the first point is $a$, and the other points are strictly below $a$.
      The general inequality will follow from this one by a simple reduction below*)
      case 2
      then have a: "extended_distance a a = 0" unfolding metric_space_class.extended_distance_set_def by auto
      have main_ineq: "extended_distance a y + extended_distance z t  max (extended_distance a z + extended_distance y t) (extended_distance a t + extended_distance y z) + 2 * deltaG(TYPE('a))"
        if yzt: "y  wo.underS a  extended_distance_set"
                "z  wo.underS a  extended_distance_set"
                "t  wo.underS a  extended_distance_set"
        for y z t
      proof (cases a)
        (*In the case of a basepoint, the desired inequality follows from the corresponding
        inequality in the original --hyperbolic-- space.*)
        case A: (basepoint a')
        then have "y  range basepoint" using metric_space_class.Bonk_Schramm_extension_unfolded_wo_props(2)
          by (metis yzt(1) Compl_iff Int_iff range_eqI wo.max2_def wo.max2_underS'(2))
        then obtain y' where y: "y = basepoint y'" by auto
        have "z  range basepoint" using metric_space_class.Bonk_Schramm_extension_unfolded_wo_props(2) A
          by (metis yzt(2) Compl_iff Int_iff range_eqI wo.max2_def wo.max2_underS'(2))
        then obtain z' where z: "z = basepoint z'" by auto
        have "t  range basepoint" using metric_space_class.Bonk_Schramm_extension_unfolded_wo_props(2) A
          by (metis yzt(3) Compl_iff Int_iff range_eqI wo.max2_def wo.max2_underS'(2))
        then obtain t' where t: "t = basepoint t'" by auto
        show ?thesis
          unfolding y z t A metric_space_class.extended_distance_basepoint
          using hyperb_quad_ineq UNIV_I unfolding Gromov_hyperbolic_subset_def by auto
      next
        (*In the case of a Cauchy sequence, the desired inequality is obtained from the inequality
        for the points defining the Cauchy sequence --which holds thanks to the induction
        assumption-- by passing to the limit.*)
        case C: (would_be_Cauchy u)
        then have u: "would_be_Cauchy u  extended_distance_set"
                     "u n  extended_distance_set  wo.underS (would_be_Cauchy u)" for n
          using metric_space_class.extended_distance_set_Cauchy 2 by auto
        have lim: "(λn. extended_distance y (u n))  (extended_distance y (would_be_Cauchy u))"
          if y: "y  extended_distance_set" for y
        proof -
          have a: "abs(extended_distance y (u n) - extended_distance y (would_be_Cauchy u))  extended_distance (u n) (would_be_Cauchy u)" for n
            using u(2)[of n] 2 y metric_space_class.extended_distance_triang_ineq unfolding C
            apply (subst abs_le_iff) apply (auto simp add: algebra_simps)
            by (metis metric_space_class.extended_distance_symmetric)
          have b: "(λn. extended_distance (u n) (would_be_Cauchy u))  0"
            unfolding C apply (rule metric_space_class.extended_distance_Cauchy(2))
            using metric_space_class.extended_distance_set_Cauchy[of u] C 2 by auto
          have "(λn. abs(extended_distance y (u n) - extended_distance y (would_be_Cauchy u)))  0"
            apply (rule tendsto_sandwich[of "λ_. 0", OF _ _ _ b]) using a by auto
          then show "(λn. extended_distance y (u n))  extended_distance y (would_be_Cauchy u)"
            using Lim_null tendsto_rabs_zero_cancel by blast
        qed
        have "max (extended_distance (u n) z + extended_distance y t) (extended_distance (u n) t + extended_distance y z) + 2 * deltaG(TYPE('a)) - extended_distance (u n) y - extended_distance z t  0" for n
          using IH[of "u n" y z t] u yzt C by auto
        moreover have "(λn. max (extended_distance (u n) z + extended_distance y t) (extended_distance (u n) t + extended_distance y z) + 2 * deltaG(TYPE('a)) - extended_distance (u n) y - extended_distance z t)
               max (extended_distance (would_be_Cauchy u) z + extended_distance y t) (extended_distance (would_be_Cauchy u) t + extended_distance y z) + 2 * deltaG(TYPE('a)) - extended_distance (would_be_Cauchy u) y - extended_distance z t"
          apply (auto intro!: tendsto_intros)
          using lim that u by (auto simp add: metric_space_class.extended_distance_symmetric)
        ultimately have I: "max (extended_distance (would_be_Cauchy u) z + extended_distance y t) (extended_distance (would_be_Cauchy u) t + extended_distance y z) + 2 * deltaG(TYPE('a)) - extended_distance (would_be_Cauchy u) y - extended_distance z t  0"
          using LIMSEQ_le_const by blast
        then show ?thesis unfolding C by auto
      next
        (*In the case of a middle, the desired inequality follows from the formula defining
        the distance to the middle, and simple computations, as explained by Bonk and Schramm.*)
        case M: (middle c d)
        then have cd: "c  extended_distance_set  wo.underS (middle c d)"
                      "d  extended_distance_set  wo.underS (middle c d)"
          using 2 metric_space_class.extended_distance_set_middle'[of c d] by auto

        have bdd: "bdd_above ((λw. extended_distance s w - max (extended_distance c w) (extended_distance d w))` (wo.underS (middle c d)  extended_distance_set))"
          if "s  extended_distance_set" for s
        proof (rule bdd_aboveI2)
          fix w assume w: "w  wo.underS (middle c d)  extended_distance_set"
          have "extended_distance s w  extended_distance s c + extended_distance c w"
            using w that metric_space_class.extended_distance_triang_ineq cd by auto
          also have "...  extended_distance s c + max (extended_distance c w) (extended_distance d w)"
            by auto
          finally show "extended_distance s w - max (extended_distance c w) (extended_distance d w)
                        extended_distance s c"
            by auto
        qed

        have I: "extended_distance y w - max (extended_distance c w) (extended_distance d w)
               max (extended_distance y z + extended_distance t (middle c d)) (extended_distance y t + extended_distance z (middle c d)) + 2 * deltaG(TYPE('a))
                - (extended_distance c d)/2 - extended_distance z t"
          if w: "w  wo.underS (middle c d)  extended_distance_set" for w
        proof -
          have J: "(extended_distance c d)/2 + extended_distance s w - max (extended_distance c w) (extended_distance d w)  extended_distance s (middle c d)"
              if "s  wo.underS a  extended_distance_set" for s
          proof -
            have "(extended_distance c d)/2 + extended_distance s w - max (extended_distance c w) (extended_distance d w)
                 (extended_distance c d)/2
                    + (SUP wwo.underS (middle c d)  extended_distance_set. extended_distance s w - max (extended_distance c w) (extended_distance d w))"
              apply auto apply (rule cSUP_upper) using w bdd that by auto
            also have "... = extended_distance s (middle c d)"
              apply (rule metric_space_class.extended_distance_middle_formula[symmetric]) using that M by auto
            finally show ?thesis by simp
          qed
          have "(extended_distance c d)/2 + extended_distance y w - max (extended_distance c w) (extended_distance d w) + extended_distance z t
             (extended_distance c d)/2 + max (extended_distance y z + extended_distance t w) (extended_distance y t + extended_distance z w) + 2 * deltaG(TYPE('a)) - max (extended_distance c w) (extended_distance d w)"
              using IH[of y w z t] w yzt M by (auto simp add: metric_space_class.extended_distance_symmetric)
          also have "... = max (extended_distance y z + (extended_distance c d)/2 + extended_distance t w - max (extended_distance c w) (extended_distance d w))
                               (extended_distance y t + (extended_distance c d)/2 + extended_distance z w - max (extended_distance c w) (extended_distance d w))
                            + 2 * deltaG(TYPE('a))"
            by auto
          also have "...  max (extended_distance y z + extended_distance t (middle c d)) (extended_distance y t + extended_distance z (middle c d)) + 2 * deltaG(TYPE('a))"
            using J[OF yzt(3)] J[OF yzt(2)] by auto
          finally show ?thesis by simp
        qed
        have *: "(SUP wwo.underS (middle c d)  extended_distance_set. extended_distance y w - max (extended_distance c w) (extended_distance d w)) 
                max (extended_distance y z + extended_distance t (middle c d)) (extended_distance y t + extended_distance z (middle c d)) + 2 * deltaG(TYPE('a))
                - (extended_distance c d)/2 - extended_distance z t"
          apply (rule cSUP_least) using yzt(1) M I by auto
        have "extended_distance y (middle c d) + extended_distance z t
          = (extended_distance c d)/2 + (SUP wwo.underS (middle c d)  extended_distance_set. extended_distance y w - max (extended_distance c w) (extended_distance d w)) + extended_distance z t"
          apply simp apply (rule metric_space_class.extended_distance_middle_formula) using yzt(1) M by auto
        also have "...  max (extended_distance y z + extended_distance t (middle c d)) (extended_distance y t + extended_distance z (middle c d)) + 2 * deltaG(TYPE('a))"
          using * by simp
        finally show "extended_distance a y + extended_distance z t
                 max (extended_distance a z + extended_distance y t) (extended_distance a t + extended_distance y z) + 2 * deltaG(TYPE('a))"
          unfolding M by (auto simp add: metric_space_class.extended_distance_symmetric)
      qed

      (*To prove the general inequality, we consider
      separately if each point is equal to $a$ or different from $a$. If no point is equal to $a$,
      then the inequality follows from the induction assumption. If exactly one point is equal to
      $a$, we can put in first position by permuting the variables, and use the main inequality
      above.
      Finally, if at least two points are equal to $a$, then the inequality follows from the
      triangular inequality.
      This reduction is straightforward, and should be automatable, but since there are 4 variables
      it is too complicated for metis, and we have to do it by hand below.*)
      show ?thesis
      proof (auto)
        fix x y z t assume H: "x  wo.under a" "x  extended_distance_set"
                              "y  wo.under a" "y  extended_distance_set"
                              "z  wo.under a" "z  extended_distance_set"
                              "t  wo.under a" "t  extended_distance_set"
        have *: "((x  wo.underS a  extended_distance_set)  (x = a))
                 ((y  wo.underS a  extended_distance_set)  (y = a))
                 ((z  wo.underS a  extended_distance_set)  (z = a))
                 ((t  wo.underS a  extended_distance_set)  (t = a))"
          using H by (simp add: underS_def under_def)
        have d: "2 * deltaG(TYPE('a))  0" by auto
        show "extended_distance x y + extended_distance z t  max (extended_distance x z + extended_distance y t) (extended_distance x t + extended_distance y z) + 2 * deltaG(TYPE('a))"
          using * apply (auto simp add: metric_space_class.extended_distance_symmetric a)
          using IH[of x y z t] apply (simp add: metric_space_class.extended_distance_symmetric)
          using main_ineq[of z x y] apply (simp add: metric_space_class.extended_distance_symmetric)
          using main_ineq[of t x y] apply (simp add: metric_space_class.extended_distance_symmetric)
          using 2 metric_space_class.extended_distance_triang_ineq[of x a y] H apply (simp add: metric_space_class.extended_distance_symmetric) using d apply linarith
          using main_ineq[of x z t] apply (simp add: metric_space_class.extended_distance_symmetric)
          using d apply linarith
          using d apply linarith
          using main_ineq[of y z t] apply (simp add: metric_space_class.extended_distance_symmetric)
          using d apply linarith
          using d apply linarith
          using 2 metric_space_class.extended_distance_triang_ineq[of t a z] H apply (simp add: metric_space_class.extended_distance_symmetric) using d apply linarith
          done
      qed
    qed
  qed
  define b where "b = wo.max2 (wo.max2 x y) (wo.max2 z t)"
  have "x  wo.under b" "y  wo.under b" "z  wo.under b" "t  wo.under b" unfolding b_def
    apply (auto simp add: under_def)
    by (metis UNIV_I metric_space_class.Bonk_Schramm_extension_unfolded_wo_props(1) mem_Collect_eq under_def well_order_on_Well_order wo.TOTALS wo.max2_iff)+
  then show ?thesis using ineq_rec[of b] assms by auto
qed

lemma (in Gromov_hyperbolic_space) Bonk_Schramm_extension_hyperbolic:
  "Gromov_hyperbolic_subset (deltaG(TYPE('a))) (UNIV::('a Bonk_Schramm_extension) set)"
apply (rule Gromov_hyperbolic_subsetI, simp, transfer fixing: deltaG)
using metric_space_class.extended_distance_set_def Bonk_Schramm_extension_unfolded_hyperbolic by auto

instantiation Bonk_Schramm_extension :: (Gromov_hyperbolic_space) Gromov_hyperbolic_space_geodesic
begin
definition deltaG_Bonk_Schramm_extension::"('a Bonk_Schramm_extension) itself  real" where
  "deltaG_Bonk_Schramm_extension _ = deltaG(TYPE('a))"

instance apply standard
unfolding deltaG_Bonk_Schramm_extension_def using Bonk_Schramm_extension_hyperbolic by auto
end (* of instantiation proof *)


text ‹Finally, it follows that the Bonk Schramm extension of a $0$-hyperbolic space
(in which it embeds isometrically) is a metric tree or, equivalently, a geodesic $0$-hyperbolic
space (the equivalence is proved at the end of \verb+Geodesic_Spaces.thy+).›

instance Bonk_Schramm_extension :: (Gromov_hyperbolic_space_0) Gromov_hyperbolic_space_0_geodesic
by (standard, simp add: deltaG_Bonk_Schramm_extension_def delta0)

text ‹It then follows that it is also a metric tree, from what we have already proved.
We write explicitly for definiteness.›

instance Bonk_Schramm_extension :: (Gromov_hyperbolic_space_0) metric_tree
  by standard


subsection ‹Applications›

text ‹We deduce that we can extend results on Gromov-hyperbolic spaces without the geodesicity assumption,
even if it is used in the proofs. These results are given for illustrative purpose mainly, as one
works most often in geodesic spaces anyway.

The following results have already been proved in hyperbolic geodesic spaces. The same results
follow in a general hyperbolic space, as everything is invariant under isometries and can thus
be pulled from the corresponding result in the Bonk Schramm extension. The straightforward proofs
only express this invariance under isometries of all the properties under consideration.›

proposition (in Gromov_hyperbolic_space) lipschitz_path_close_to_geodesic':
  fixes c::"real  'a"
  assumes "lipschitz_on M {A..B} c"
          "geodesic_segment_between G (c A) (c B)"
          "x  G"
  shows "infdist x (c`{A..B})  (4/ln 2) * deltaG(TYPE('a)) * max 0 (ln (B-A)) + M"
proof -
  interpret BS: Gromov_hyperbolic_space_geodesic "dist::('a Bonk_Schramm_extension  'a Bonk_Schramm_extension  real)" "uniformity" "open" "(λ_. deltaG(TYPE('a)))"
    apply standard using Bonk_Schramm_extension_hyperbolic by auto

  have "infdist x (c`{A..B}) = infdist (to_Bonk_Schramm_extension x) ((to_Bonk_Schramm_extension o c)`{A..B})"
    unfolding image_comp[symmetric] apply (rule isometry_preserves_infdist[symmetric, of UNIV])
    using to_Bonk_Schramm_extension_isometry by auto
  also have "...  (4/ln 2) * deltaG(TYPE(('a))) * max 0 (ln (B-A)) + (1*M)"
    apply (rule BS.lipschitz_path_close_to_geodesic[of _ _ _ _ "to_Bonk_Schramm_extension`G"])
    apply (rule lipschitz_on_compose)
    using assms apply simp
    apply (meson UNIV_I isometry_on_lipschitz lipschitz_on_def to_Bonk_Schramm_extension_isometry)
    unfolding comp_def apply (rule isometry_preserves_geodesic_segment_between[of UNIV])
    using assms to_Bonk_Schramm_extension_isometry by auto
  finally show ?thesis by auto
qed

theorem (in Gromov_hyperbolic_space) Morse_Gromov_theorem':
  fixes f::"real  'a"
  assumes "lambda C-quasi_isometry_on {a..b} f"
          "geodesic_segment_between G (f a) (f b)"
  shows "hausdorff_distance (f`{a..b}) G  92 * lambda2 * (C + deltaG(TYPE('a)))"
proof -
  interpret BS: Gromov_hyperbolic_space_geodesic "dist::('a Bonk_Schramm_extension  'a Bonk_Schramm_extension  real)" "uniformity" "open" "(λ_. deltaG(TYPE('a)))"
    apply standard using Bonk_Schramm_extension_hyperbolic by auto
  have "hausdorff_distance (f`{a..b}) (G) = hausdorff_distance ((to_Bonk_Schramm_extension o f)`{a..b}) ((to_Bonk_Schramm_extension)`G)"
    unfolding image_comp[symmetric] apply (rule isometry_preserves_hausdorff_distance[symmetric, of UNIV])
    using to_Bonk_Schramm_extension_isometry by auto
  also have "...  92 * (lambda*1)^2 * ((C*1+0) + deltaG(TYPE('a)))"
    apply (intro BS.Morse_Gromov_theorem quasi_isometry_on_compose[where Y = UNIV])
    using assms isometry_quasi_isometry_on to_Bonk_Schramm_extension_isometry apply auto
    using isometry_preserves_geodesic_segment_between by blast
  finally show ?thesis by simp
qed

theorem (in Gromov_hyperbolic_space) Morse_Gromov_theorem2':
  fixes c d::"real  'a"
  assumes "lambda C-quasi_isometry_on {A..B} c"
          "lambda C-quasi_isometry_on {A..B} d"
          "c A = d A" "c B = d B"
  shows "hausdorff_distance (c`{A..B}) (d`{A..B})  184 * lambda^2 * (C + deltaG(TYPE('a)))"
proof -
  interpret BS: Gromov_hyperbolic_space_geodesic "dist::('a Bonk_Schramm_extension  'a Bonk_Schramm_extension  real)" "uniformity" "open" "(λ_. deltaG(TYPE('a)))"
    apply standard using Bonk_Schramm_extension_hyperbolic by auto
  have "hausdorff_distance (c`{A..B}) (d`{A..B}) = hausdorff_distance ((to_Bonk_Schramm_extension o c)`{A..B}) ((to_Bonk_Schramm_extension o d)`{A..B})"
    unfolding image_comp[symmetric] apply (rule isometry_preserves_hausdorff_distance[symmetric, of UNIV])
    using to_Bonk_Schramm_extension_isometry by auto
  also have "...  184 * (lambda*1)^2 * ((C*1+0) + deltaG(TYPE('a)))"
    apply (intro BS.Morse_Gromov_theorem2 quasi_isometry_on_compose[where Y = UNIV])
    using assms isometry_quasi_isometry_on to_Bonk_Schramm_extension_isometry by auto
  finally show ?thesis by simp
qed

lemma Gromov_hyperbolic_invariant_under_quasi_isometry_explicit':
  fixes f::"'a::geodesic_space  'b::Gromov_hyperbolic_space"
  assumes "lambda C-quasi_isometry f"
  shows "Gromov_hyperbolic_subset (752 * lambda^3 * (C + deltaG(TYPE('b)))) (UNIV::('a set))"
proof -
  interpret BS: Gromov_hyperbolic_space_geodesic "dist::('b Bonk_Schramm_extension  'b Bonk_Schramm_extension  real)" "uniformity" "open" "(λ_. deltaG(TYPE('b)))"
    apply standard using Bonk_Schramm_extension_hyperbolic by auto
  have A: "(lambda * 1) (C * 1 + 0)-quasi_isometry_on UNIV (to_Bonk_Schramm_extension o f)"
    by (rule quasi_isometry_on_compose[OF assms, of _ _ UNIV])
       (auto simp add: isometry_quasi_isometry_on[OF to_Bonk_Schramm_extension_isometry])
  have *: "deltaG(TYPE('b)) = deltaG(TYPE('b Bonk_Schramm_extension))"
    by (simp add: deltaG_Bonk_Schramm_extension_def)
  show ?thesis
    unfolding *
    apply (rule Gromov_hyperbolic_invariant_under_quasi_isometry_explicit[of _ _ "to_Bonk_Schramm_extension o f"])
    using A by auto
qed

theorem Gromov_hyperbolic_invariant_under_quasi_isometry':
  assumes "quasi_isometric (UNIV::('a::geodesic_space) set) (UNIV::('b::Gromov_hyperbolic_space) set)"
  shows "delta. Gromov_hyperbolic_subset delta (UNIV::'a set)"
proof -
  obtain C lambda f where f: "lambda C-quasi_isometry_between (UNIV::'a set) (UNIV::'b set) f"
    using assms unfolding quasi_isometric_def by auto
  show ?thesis using Gromov_hyperbolic_invariant_under_quasi_isometry_explicit'[OF quasi_isometry_betweenD(1)[OF f]] by blast
qed

end (*of theory Bonk_Schramm_Extension*)

Theory Gromov_Boundary

(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
    License: BSD
*)

theory Gromov_Boundary
  imports Gromov_Hyperbolicity Eexp_Eln
begin

section ‹Constructing a distance from a quasi-distance›

text ‹Below, we will construct a distance on the Gromov completion of a hyperbolic space. The
geometrical object that arises naturally is almost a distance, but it does not satisfy the triangular
inequality. There is a general process to turn such a quasi-distance into a genuine distance, as
follows: define the new distance $\tilde d(x,y)$ to be the infimum of $d(x, u_1) + d(u_1,u_2) +
\dotsb + d(u_{n-1},x)$ over all sequences of points (of any length) connecting $x$ to $y$.
It is clear that it satisfies the triangular inequality, is symmetric, and $\tilde d(x,y) \leq
d(x,y)$. What is not clear, however, is if $\tilde d(x,y)$ can be zero if $x \neq y$, or more
generally how one can bound $\tilde d$ from below. The main point of this contruction is that,
if $d$ satisfies the inequality $d(x,z) \leq \sqrt{2} \max(d(x,y), d(y,z))$, then one
has $\tilde d(x,y) \geq d(x,y)/2$ (and in particular $\tilde d$ defines the same topology, the
same set of Lipschitz functions, and so on, as $d$).

This statement can be found in [Bourbaki, topologie generale, chapitre 10] or in
[Ghys-de la Harpe] for instance. We follow their proof.
›

definition turn_into_distance::"('a  'a  real)  ('a  'a  real)"
  where "turn_into_distance f x y = Inf {( i  {0..<n}. f (u i) (u (Suc i)))| u (n::nat). u 0 = x  u n = y}"

locale Turn_into_distance =
  fixes f::"'a  'a  real"
  assumes nonneg: "f x y  0"
      and sym: "f x y = f y x"
      and self_zero: "f x x = 0"
      and weak_triangle: "f x z  sqrt 2 * max (f x y) (f y z)"
begin

text ‹The two lemmas below are useful when dealing with Inf results, as they always require
the set under consideration to be non-empty and bounded from below.›

lemma bdd_below [simp]:
  "bdd_below {( i = 0..<n. f (u i) (u (Suc i)))| u (n::nat). u 0 = x  u n = y}"
  apply (rule bdd_belowI[of _ 0]) using nonneg by (auto simp add: sum_nonneg)

lemma nonempty:
  "{i = 0..<n. f (u i) (u (Suc i)) |u n. u 0 = x  u n = y}  {}"
proof -
  define u::"nat  'a" where "u = (λn. if n = 0 then x else y)"
  define n::nat where "n = 1"
  have "u 0 = x  u n = y" unfolding u_def n_def by auto
  then have "(i = 0..<n. f (u i) (u (Suc i)))  {i = 0..<n. f (u i) (u (Suc i)) |u n. u 0 = x  u n = y}"
    by auto
  then show ?thesis by auto
qed

text ‹We can now prove that \verb+turn_into_distance f+ satisfies all the properties of a distance.
First, it is nonnegative.›

lemma TID_nonneg:
  "turn_into_distance f x y  0"
unfolding turn_into_distance_def apply (rule cInf_greatest[OF nonempty])
using nonneg by (auto simp add: sum_nonneg)

text ‹For the symmetry, we use the symmetry of $f$, and go backwards along a chain of points,
replacing a sequence from $x$ to $y$ with a sequence from $y$ to $x$.›

lemma TID_sym:
  "turn_into_distance f x y = turn_into_distance f y x"
proof -
  have "turn_into_distance f x y  Inf {( i  {0..<n}. f (u i) (u (Suc i)))| u (n::nat). u 0 = y  u n = x}" for x y
  proof (rule cInf_greatest[OF nonempty], auto)
    fix u::"nat  'a" and n assume U: "y = u 0" "x = u n"
    define v::"nat 'a" where "v = (λi. u (n-i))"
    have V: "v 0 = x" "v n = y" unfolding v_def using U by auto

    have "(i = 0..<n. f (u i) (u (Suc i))) = (i = 0..<n. (λi. f (u i) (u (Suc i))) (n-1-i))"
      apply (rule sum.reindex_bij_betw[symmetric])
      by (rule bij_betw_byWitness[of _ "λi. n-1-i"], auto)
    also have "... = ( i = 0..<n. f (v (Suc i)) (v i))"
      apply (rule sum.cong) unfolding v_def by (auto simp add: Suc_diff_Suc)
    also have "... = ( i = 0..<n. f (v i) (v (Suc i)))"
      using sym by auto
    finally have "(i = 0..<n. f (u i) (u (Suc i))) = ( i = 0..<n. f (v i) (v (Suc i)))"
      by simp

    moreover have "turn_into_distance f x y  ( i = 0..<n. f (v i) (v (Suc i)))"
      unfolding turn_into_distance_def apply (rule cInf_lower)
      using V by auto
    finally show "turn_into_distance f (u n) (u 0)  (i = 0..<n. f (u i) (u (Suc i)))"
      using U by auto
  qed
  then have *: "turn_into_distance f x y  turn_into_distance f y x" for x y
    unfolding turn_into_distance_def by auto
  show ?thesis using *[of x y] *[of y x] by simp
qed

text ‹There is a trivial upper bound by $f$, using the single chain $x, y$.›

lemma upper:
  "turn_into_distance f x y  f x y"
unfolding turn_into_distance_def proof (rule cInf_lower, auto)
  define u::"nat  'a" where "u = (λn. if n = 0 then x else y)"
  define n::nat where "n = 1"
  have "u 0 = x  u n = y  f x y = (i = 0..<n. f (u i) (u (Suc i)))" unfolding u_def n_def by auto
  then show "u n. f x y = (i = 0..<n. f (u i) (u (Suc i)))  u 0 = x  u n = y"
    by auto
qed

text ‹The new distance vanishes on a pair of equal points, as this is already the case for $f$.›

lemma TID_self_zero:
  "turn_into_distance f x x = 0"
using upper[of x x] TID_nonneg[of x x] self_zero[of x] by auto

text ‹For the triangular inequality, we concatenate a sequence from $x$ to $y$ almost realizing the
infimum, and a sequence from $y$ to $z$ almost realizing the infimum, to obtain a sequence from
$x$ to $z$ along which the sums of $f$ is almost bounded by
\verb|turn_into_distance f x y + turn_into_distance f y z|.
›

lemma triangle:
  "turn_into_distance f x z  turn_into_distance f x y + turn_into_distance f y z"
proof -
  have "turn_into_distance f x z  turn_into_distance f x y + turn_into_distance f y z + e" if "e > 0" for e
  proof -
    have "Inf {( i  {0..<n}. f (u i) (u (Suc i)))| u (n::nat). u 0 = x  u n = y} < turn_into_distance f x y + e/2"
      unfolding turn_into_distance_def using e > 0 by auto
    then have "a  {( i  {0..<n}. f (u i) (u (Suc i)))| u (n::nat). u 0 = x  u n = y}. a < turn_into_distance f x y + e/2"
      by (rule cInf_lessD[OF nonempty])
    then obtain u n where U: "u 0 = x" "u n = y" "( i  {0..<n}. f (u i) (u (Suc i))) < turn_into_distance f x y + e/2"
      by auto

    have "Inf {( i  {0..<m}. f (v i) (v (Suc i)))| v (m::nat). v 0 = y  v m = z} < turn_into_distance f y z + e/2"
      unfolding turn_into_distance_def using e > 0 by auto
    then have "a  {( i  {0..<m}. f (v i) (v (Suc i)))| v (m::nat). v 0 = y  v m = z}. a < turn_into_distance f y z + e/2"
      by (rule cInf_lessD[OF nonempty])
    then obtain v m where V: "v 0 = y" "v m = z" "( i  {0..<m}. f (v i) (v (Suc i))) < turn_into_distance f y z + e/2"
      by auto

    define w where "w = (λi. if i < n then u i else v (i-n))"
    have *: "w 0 = x" "w (n+m) = z"
      unfolding w_def using U V by auto
    have "turn_into_distance f x z  (i = 0..<n+m. f (w i) (w (Suc i)))"
      unfolding turn_into_distance_def apply (rule cInf_lower) using * by auto
    also have "... = (i = 0..<n. f (w i) (w (Suc i))) + (i = n..<n+m. f (w i) (w (Suc i)))"
      by (simp add: sum.atLeastLessThan_concat)
    also have "... = (i = 0..<n. f (w i) (w (Suc i))) + (i = 0..<m. f (w (i+n)) (w (Suc (i+n))))"
      by (auto intro!: sum.reindex_bij_betw[symmetric] bij_betw_byWitness[of _ "λi. i-n"])
    also have "... = (i = 0..<n. f (u i) (u (Suc i))) + (i = 0..<m. f (v i) (v (Suc i)))"
      unfolding w_def apply (auto intro!: sum.cong)
      using U(2) V(1) Suc_lessI by fastforce
    also have "... < turn_into_distance f x y + e/2 + turn_into_distance f y z + e/2"
      using U(3) V(3) by auto
    finally show ?thesis by auto
  qed
  then show ?thesis
    using field_le_epsilon by blast
qed

text ‹Now comes the only nontrivial statement of the construction, the fact that the new
distance is bounded from below by $f/2$.

Here is the mathematical proof. We show by induction that all chains from $x$ to
$y$ satisfy this bound. Assume this is done for all chains of length $ < n$, we do it for a
chain of length $n$. Write $S = \sum f(u_i, u_{i+1})$ for the sum along the chain. Introduce $p$
the last index where the sum is $\leq S/2$. Then the sum from $0$ to $p$ is $\leq S/2$, and the sum
from $p+1$ to $n$ is also $\leq S/2$ (by maximality of $p$). The induction assumption
gives that $f (x, u_p)$ is bounded by twice the sum from $0$ to $p$, which is at most $S$. Same
thing for $f(u_{p+1}, y)$. With the weird triangle inequality applied two times, we get
$f (x, y) \leq 2 \max(f(x,u_p), f(u_p, u_{p+1}), f(u_{p+1}, y)) \leq 2S$, as claimed.

The formalization presents no difficulty.
›

lemma lower:
  "f x y  2 * turn_into_distance f x y"
proof -
  have I: "f (u 0) (u n)  ( i  {0..<n}. f (u i) (u (Suc i))) * 2" for n u
  proof (induction n arbitrary: u rule: less_induct)
    case (less n)
    show "f (u 0) (u n)  (i = 0..<n. f (u i) (u (Suc i))) * 2"
    proof (cases "n = 0")
      case True
      then have "f (u 0) (u n) = 0" using self_zero by auto
      then show ?thesis using True by auto
    next
      case False
      then have "n > 0" by auto
      define S where "S = (i = 0..<n. f (u i) (u (Suc i)))"
      have "S  0" unfolding S_def using nonneg by (auto simp add: sum_nonneg)
      have "p. p < n  (i = 0..<p. f (u i) (u (Suc i)))  S/2  (i = Suc p..<n. f (u i) (u (Suc i)))  S/2"
      proof (cases "S = 0")
        case True
        have "(i = Suc 0..<n. f (u i) (u (Suc i))) = (i = 0..<n. f (u i) (u (Suc i))) - f(u 0) (u (Suc 0))"
          using sum.atLeast_Suc_lessThan[OF n > 0, of "λi. f (u i) (u (Suc i))"] by simp
        also have "...  S/2" using True S_def nonneg by auto
        finally have "0 < n  (i = 0..<0. f (u i) (u (Suc i)))  S/2  (i = Suc 0..<n. f (u i) (u (Suc i)))  S/2"
          using n > 0 S = 0 by auto
        then show ?thesis by auto
      next
        case False
        then have "S > 0" using S  0 by simp
        define A where "A = {q. q  n  (i = 0..<q. f (u i) (u (Suc i)))  S/2}"
        have "0  A" unfolding A_def using S > 0 n > 0 by auto
        have "n  A" unfolding A_def using S > 0 unfolding S_def by auto
        define p where "p = Max A"
        have "p  A" unfolding p_def apply (rule Max_in) using 0  A unfolding A_def by auto
        then have L: "p  n" "(i = 0..<p. f (u i) (u (Suc i)))  S/2" unfolding A_def by auto
        then have "p < n" using n  A p  A le_neq_trans by blast
        have "Suc p  A" unfolding p_def
          by (metis (no_types, lifting) A_def Max_ge Suc_n_not_le_n infinite_nat_iff_unbounded mem_Collect_eq not_le p_def)
        then have *: "(i = 0..<Suc p. f (u i) (u (Suc i))) > S/2"
          unfolding A_def using p < n by auto
        have "( i = Suc p..<n. f (u i) (u (Suc i))) = S - (i = 0..<Suc p. f (u i) (u (Suc i)))"
          unfolding S_def using p < n by (metis (full_types) Suc_le_eq sum_diff_nat_ivl zero_le)
        also have "...  S/2" using * by auto
        finally have "p < n  (i = 0..<p. f (u i) (u (Suc i)))  S/2  (i = Suc p..<n. f (u i) (u (Suc i)))  S/2"
          using p < n L(2) by auto
        then show ?thesis by auto
      qed
      then obtain p where P: "p < n" "(i = 0..<p. f (u i) (u (Suc i)))  S/2" "(i = Suc p..<n. f (u i) (u (Suc i)))  S/2"
        by auto
      have "f (u 0) (u p)  (i = 0..<p. f (u i) (u (Suc i))) * 2"
        apply (rule less.IH) using p < n by auto
      then have A: "f (u 0) (u p)  S" using P(2) by auto
      have B: "f (u p) (u (Suc p))  S"
        apply (rule sum_nonneg_leq_bound[of "{0..<n}" "λi. f (u i) (u (Suc i))"])
        using nonneg S_def p < n by auto
      have "f (u (0 + Suc p)) (u ((n-Suc p) + Suc p))  (i = 0..<n-Suc p. f (u (i + Suc p)) (u (Suc i + Suc p))) * 2"
        apply (rule less.IH) using n > 0 by auto
      also have "... = 2 * (i = Suc p..<n. f (u i) (u (Suc i)))"
        by (auto intro!: sum.reindex_bij_betw bij_betw_byWitness[of _ "λi. i - Suc p"])
      also have "...  S" using P(3) by simp
      finally have C: "f (u (Suc p)) (u n)  S"
        using p < n by auto

      have "f (u 0) (u n)  sqrt 2 * max (f (u 0) (u p)) (f (u p) (u n))"
        using weak_triangle by simp
      also have "...  sqrt 2* max (f (u 0) (u p)) (sqrt 2 * max (f (u p) (u (Suc p))) (f (u (Suc p)) (u n)))"
        using weak_triangle by simp (meson max.cobounded2 order_trans)
      also have "...  sqrt 2 * max S (sqrt 2 * max S S)"
        using A B C by auto (simp add: le_max_iff_disj)
      also have "...  sqrt 2 * max (sqrt 2 * S) (sqrt 2 * max S S)"
        apply (intro mult_left_mono max.mono) using S  0 less_eq_real_def by auto
      also have "... = 2 * S"
        by auto
      finally show ?thesis
        unfolding S_def by simp
    qed
  qed
  have "f x y/2  turn_into_distance f x y"
    unfolding turn_into_distance_def by (rule cInf_greatest[OF nonempty], auto simp add: I)
  then show ?thesis by simp
qed

end (*of locale Turn_into_distance*)


section ‹The Gromov completion of a hyperbolic space›

subsection ‹The Gromov boundary as a set›

text ‹A sequence in a Gromov hyperbolic space converges to a point in the boundary if
the Gromov product $(u_n, u_m)_e$ tends to infinity when $m,n \to _infty$. The point at infinity
is defined as the equivalence class of such sequences, for the relation $u \sim v$ iff
$(u_n, v_n)_e \to \infty$ (or, equivalently, $(u_n, v_m)_e \to \infty$ when $m, n\to \infty$, or
one could also change basepoints). Hence, the Gromov boundary is naturally defined as a quotient
type. There is a difficulty: it can be empty in general, hence defining it as a type is not always
possible. One could introduce a new typeclass of Gromov hyperbolic spaces for which the boundary
is not empty (unboundedness is not enough, think of infinitely many segments $[0,n]$ all joined at
$0$), and then only define the boundary of such spaces. However, this is tedious. Rather, we
work with the Gromov completion (containing the space and its boundary), this is always not empty.
The price to pay is that, in the definition of the completion, we have to distinguish between
sequences converging to the boundary and sequences converging inside the space. This is more natural
to proceed in this way as the interesting features of the boundary come from the fact that its sits
at infinity of the initial space, so their relations (and the topology of $X \cup \partial X$) are
central.›

definition Gromov_converging_at_boundary::"(nat  ('a::Gromov_hyperbolic_space))  bool"
  where "Gromov_converging_at_boundary u = (a. (M::real). N. n  N.  m  N. Gromov_product_at a (u m) (u n)  M)"

lemma Gromov_converging_at_boundaryI:
  assumes "M. N. n  N. m  N. Gromov_product_at a (u m) (u n)  M"
  shows "Gromov_converging_at_boundary u"
unfolding Gromov_converging_at_boundary_def proof (auto)
  fix b::'a and M::real
  obtain N where *: "m n. n  N  m  N  Gromov_product_at a (u m) (u n)  M + dist a b"
    using assms[of "M + dist a b"] by auto
  have "Gromov_product_at b (u m) (u n)  M" if "m  N" "n  N" for m n
    using *[OF that] Gromov_product_at_diff1[of a "u m" "u n" b] by (smt Gromov_product_commute)
  then show "N. n  N. m  N. M  Gromov_product_at b (u m) (u n)" by auto
qed

lemma Gromov_converging_at_boundary_imp_unbounded:
  assumes "Gromov_converging_at_boundary u"
  shows "(λn. dist a (u n))  "
proof -
  have "N. n  N. dist a (u n)  M" for M::real
    using assms unfolding Gromov_converging_at_boundary_def Gromov_product_e_x_x[symmetric] by meson
  then show ?thesis
    unfolding tendsto_PInfty eventually_sequentially by (meson dual_order.strict_trans1 gt_ex less_ereal.simps(1))
qed

lemma Gromov_converging_at_boundary_imp_not_constant:
  "¬(Gromov_converging_at_boundary (λn. x))"
  using Gromov_converging_at_boundary_imp_unbounded[of "(λn. x)" "x"] Lim_bounded_PInfty by auto

lemma Gromov_converging_at_boundary_imp_not_constant':
  assumes "Gromov_converging_at_boundary u"
  shows "¬(m n. u m = u n)"
  using Gromov_converging_at_boundary_imp_not_constant
  by (metis (no_types) Gromov_converging_at_boundary_def assms order_refl)

text ‹We introduce a partial equivalence relation, defined over the sequences that converge to
infinity, and the constant sequences. Quotienting the space of admissible sequences by this
equivalence relation will give rise to the Gromov completion.›

definition Gromov_completion_rel::"(nat  'a::Gromov_hyperbolic_space)  (nat  'a)  bool"
  where "Gromov_completion_rel u v =
            (((Gromov_converging_at_boundary u  Gromov_converging_at_boundary v  (a. (λn. Gromov_product_at a (u n) (v n))  )))
             (n m. u n = v m  u n = u m  v n = v m))"

text ‹We need some basic lemmas to work separately with sequences tending to the boundary
and with constant sequences, as follows.›

lemma Gromov_completion_rel_const [simp]:
  "Gromov_completion_rel (λn. x) (λn. x)"
unfolding Gromov_completion_rel_def by auto

lemma Gromov_completion_rel_to_const:
  assumes "Gromov_completion_rel u (λn. x)"
  shows "u n = x"
using assms unfolding Gromov_completion_rel_def using Gromov_converging_at_boundary_imp_not_constant[of x] by auto

lemma Gromov_completion_rel_to_const':
  assumes "Gromov_completion_rel (λn. x) u"
  shows "u n = x"
using assms unfolding Gromov_completion_rel_def using Gromov_converging_at_boundary_imp_not_constant[of x] by auto

lemma Gromov_product_tendsto_PInf_a_b:
  assumes "(λn. Gromov_product_at a (u n) (v n))  "
  shows "(λn. Gromov_product_at b (u n) (v n))  "
proof (rule tendsto_sandwich[of "λn. ereal(Gromov_product_at a (u n) (v n)) + (- dist a b)" _ _ "λn. "])
  have "ereal(Gromov_product_at b (u n) (v n))  ereal(Gromov_product_at a (u n) (v n)) + (- dist a b)" for n
    using Gromov_product_at_diff1[of a "u n" "v n" b] by auto
  then show "F n in sequentially. ereal (Gromov_product_at a (u n) (v n)) + ereal (- dist a b)  ereal (Gromov_product_at b (u n) (v n))"
    by auto
  have "(λn. ereal(Gromov_product_at a (u n) (v n)) + (- dist a b))   + (- dist a b)"
    apply (intro tendsto_intros) using assms by auto
  then show "(λn. ereal (Gromov_product_at a (u n) (v n)) + ereal (- dist a b))  " by simp
qed (auto)

lemma Gromov_converging_at_boundary_rel:
  assumes "Gromov_converging_at_boundary u"
  shows "Gromov_completion_rel u u"
unfolding Gromov_completion_rel_def using Gromov_converging_at_boundary_imp_unbounded[OF assms] assms by auto

text ‹We can now prove that we indeed have an equivalence relation.›

lemma part_equivp_Gromov_completion_rel:
  "part_equivp Gromov_completion_rel"
proof (rule part_equivpI)
  show "x::(nat  'a). Gromov_completion_rel x x"
    apply (rule exI[of _ "λn. (SOME a::'a. True)"]) unfolding Gromov_completion_rel_def by (auto simp add: convergent_const)

  show "symp Gromov_completion_rel"
    unfolding symp_def Gromov_completion_rel_def by (auto simp add: Gromov_product_commute) metis+

  show "transp (Gromov_completion_rel::(nat  'a)  (nat  'a)  bool)"
  unfolding transp_def proof (intro allI impI)
    fix u v w::"nat'a"
    assume UV: "Gromov_completion_rel u v"
       and VW: "Gromov_completion_rel v w"
    show "Gromov_completion_rel u w"
    proof (cases "n m. v n = v m")
      case True
      define a where "a = v 0"
      have *: "v = (λn. a)" unfolding a_def using True by auto
      then have "u n = v 0" "w n = v 0" for n
        using Gromov_completion_rel_to_const' Gromov_completion_rel_to_const UV VW unfolding * by auto force
      then show ?thesis
        using UV VW unfolding Gromov_completion_rel_def by auto
    next
      case False
      have "(λn. Gromov_product_at a (u n) (w n))  " for a
      proof (rule tendsto_sandwich[of "λn. min (ereal (Gromov_product_at a (u n) (v n))) (ereal (Gromov_product_at a (v n) (w n))) + (- deltaG(TYPE('a)))" _ _ "λn. "])
        have "min (Gromov_product_at a (u n) (v n)) (Gromov_product_at a (v n) (w n)) - deltaG(TYPE('a))  Gromov_product_at a (u n) (w n)" for n
          by (rule hyperb_ineq)
        then have "min (ereal (Gromov_product_at a (u n) (v n))) (ereal (Gromov_product_at a (v n) (w n))) + ereal (- deltaG TYPE('a))  ereal (Gromov_product_at a (u n) (w n))" for n
          by (auto simp del: ereal_min simp add: ereal_min[symmetric])
        then show "F n in sequentially. min (ereal (Gromov_product_at a (u n) (v n))) (ereal (Gromov_product_at a (v n) (w n)))
                    + ereal (- deltaG TYPE('a))  ereal (Gromov_product_at a (u n) (w n))"
          unfolding eventually_sequentially by auto

        have "(λn. min (ereal (Gromov_product_at a (u n) (v n))) (ereal (Gromov_product_at a (v n) (w n))) + (- deltaG(TYPE('a))))  min   + (- deltaG(TYPE('a)))"
          apply (intro tendsto_intros) using UV VW False unfolding Gromov_completion_rel_def by auto
        then show "(λn. min (ereal (Gromov_product_at a (u n) (v n))) (ereal (Gromov_product_at a (v n) (w n))) + (- deltaG(TYPE('a))))  " by auto
      qed (auto)
      then show ?thesis
        using False UV VW unfolding Gromov_completion_rel_def by auto
    qed
  qed
qed

text ‹We can now define the Gromov completion of a Gromov hyperbolic space, considering either
sequences converging to a point on the boundary, or sequences converging inside the space, and
quotienting by the natural equivalence relation.›

quotient_type (overloaded) 'a Gromov_completion =
  "nat  ('a::Gromov_hyperbolic_space)"
  / partial: "Gromov_completion_rel"
by (rule part_equivp_Gromov_completion_rel)

text ‹The Gromov completion contains is made of a copy of the original space, and new points
forming the Gromov boundary.›

definition to_Gromov_completion::"('a::Gromov_hyperbolic_space)  'a Gromov_completion"
  where "to_Gromov_completion x = abs_Gromov_completion (λn. x)"

definition from_Gromov_completion::"('a::Gromov_hyperbolic_space) Gromov_completion  'a"
  where "from_Gromov_completion = inv to_Gromov_completion"

definition Gromov_boundary::"('a::Gromov_hyperbolic_space) Gromov_completion set"
  where "Gromov_boundary = UNIV - range to_Gromov_completion"

lemma to_Gromov_completion_inj:
  "inj to_Gromov_completion"
proof (rule injI)
  fix x y::'a assume H: "to_Gromov_completion x = to_Gromov_completion y"
  have "Gromov_completion_rel (λn. x) (λn. y)"
    apply (subst Quotient3_rel[OF Quotient3_Gromov_completion, symmetric])
    using H unfolding to_Gromov_completion_def by auto
  then show "x = y"
    using Gromov_completion_rel_to_const by auto
qed

lemma from_to_Gromov_completion [simp]:
  "from_Gromov_completion (to_Gromov_completion x) = x"
unfolding from_Gromov_completion_def by (simp add: to_Gromov_completion_inj)

lemma to_from_Gromov_completion:
  assumes "x  Gromov_boundary"
  shows "to_Gromov_completion (from_Gromov_completion x) = x"
using assms to_Gromov_completion_inj unfolding Gromov_boundary_def from_Gromov_completion_def
by (simp add: f_inv_into_f)

lemma not_in_Gromov_boundary:
  assumes "x  Gromov_boundary"
  shows "a. x = to_Gromov_completion a"
using assms unfolding Gromov_boundary_def by auto

lemma not_in_Gromov_boundary' [simp]:
  "to_Gromov_completion x  Gromov_boundary"
unfolding Gromov_boundary_def by auto

lemma abs_Gromov_completion_in_Gromov_boundary [simp]:
  assumes "Gromov_converging_at_boundary u"
  shows "abs_Gromov_completion u  Gromov_boundary"
using Gromov_completion_rel_to_const Gromov_converging_at_boundary_imp_not_constant'
  Gromov_converging_at_boundary_rel[OF assms]
  Quotient3_rel[OF Quotient3_Gromov_completion] assms not_in_Gromov_boundary to_Gromov_completion_def
  by fastforce

lemma rep_Gromov_completion_to_Gromov_completion [simp]:
  "rep_Gromov_completion (to_Gromov_completion y) = (λn. y)"
proof -
  have "Gromov_completion_rel (λn. y) (rep_Gromov_completion (abs_Gromov_completion (λn. y)))"
    by (metis Gromov_completion_rel_const Quotient3_Gromov_completion rep_abs_rsp)
  then show ?thesis
    unfolding to_Gromov_completion_def using Gromov_completion_rel_to_const' by blast
qed

text ‹To distinguish the case of points inside the space or in the boundary, we introduce the
following case distinction.›

lemma Gromov_completion_cases [case_names to_Gromov_completion boundary, cases type: Gromov_completion]:
  "(x. z = to_Gromov_completion x  P)  (z  Gromov_boundary  P)  P"
apply (cases "z  Gromov_boundary") using not_in_Gromov_boundary by auto


subsection ‹Extending the original distance and the original Gromov product to the completion›

text ‹In this subsection, we extend the Gromov product to the boundary, by taking limits along
sequences tending to the point in the boundary. This does not converge, but it does up to $\delta$,
so for definiteness we use a $\liminf$ over all sequences tending to the boundary point -- one
interest of this definition is that the extended Gromov product still satisfies the hyperbolicity
inequality. One difficulty is that this extended Gromov product can take infinite values (it does
so exactly on the pair $(x,x)$ where $x$ is in the boundary), so we should define this product
in extended nonnegative reals.

We also extend the original distance, by $+\infty$ on the boundary. This is not a really interesting
function, but it will be instrumental below. Again, this extended Gromov distance (not to be mistaken
for the genuine distance we will construct later on on the completion) takes values in extended
nonnegative reals.

Since the extended Gromov product and the extension of the original distance both take values in
$[0,+\infty]$, it may seem natural to define them in ennreal. This is the choice that was made in
a previous implementation, but it turns out that one keeps computing with these numbers, writing
down inequalities and subtractions. ennreal is ill suited for this kind of computations, as it only
works well with additions. Hence, the implementation was switched to ereal, where proofs are indeed
much smoother.

To define the extended Gromov product, one takes a limit of the Gromov product along any
sequence, as it does not depend up to $\delta$ on the chosen sequence. However, if one wants to
keep the exact inequality that defines hyperbolicity, but at all points, then using an infimum
is the best choice.›

definition extended_Gromov_product_at::"('a::Gromov_hyperbolic_space)  'a Gromov_completion  'a Gromov_completion  ereal"
  where "extended_Gromov_product_at e x y = Inf {liminf (λn. ereal(Gromov_product_at e (u n) (v n))) |u v. abs_Gromov_completion u = x  abs_Gromov_completion v = y  Gromov_completion_rel u u  Gromov_completion_rel v v}"

definition extended_Gromov_distance::"('a::Gromov_hyperbolic_space) Gromov_completion  'a Gromov_completion  ereal"
  where "extended_Gromov_distance x y =
              (if x  Gromov_boundary  y  Gromov_boundary then 
              else ereal (dist (inv to_Gromov_completion x) (inv to_Gromov_completion y)))"

text ‹The extended distance and the extended Gromov product are invariant under exchange
of the points, readily from the definition.›

lemma extended_Gromov_distance_commute:
  "extended_Gromov_distance x y = extended_Gromov_distance y x"
unfolding extended_Gromov_distance_def by (simp add: dist_commute)

lemma extended_Gromov_product_nonneg [mono_intros, simp]:
  "0  extended_Gromov_product_at e x y"
unfolding extended_Gromov_product_at_def by (rule Inf_greatest, auto intro: Liminf_bounded always_eventually)

lemma extended_Gromov_distance_nonneg [mono_intros, simp]:
  "0  extended_Gromov_distance x y"
unfolding extended_Gromov_distance_def by auto

lemma extended_Gromov_product_at_commute:
  "extended_Gromov_product_at e x y = extended_Gromov_product_at e y x"
unfolding extended_Gromov_product_at_def
proof (rule arg_cong[of _ _ Inf])
  have "{liminf (λn. ereal (Gromov_product_at e (u n) (v n))) |u v.
          abs_Gromov_completion u = x  abs_Gromov_completion v = y  Gromov_completion_rel u u  Gromov_completion_rel v v} =
        {liminf (λn. ereal (Gromov_product_at e (v n) (u n))) |u v.
          abs_Gromov_completion v = y  abs_Gromov_completion u = x  Gromov_completion_rel v v  Gromov_completion_rel u u}"
    by (auto simp add: Gromov_product_commute)
  then show "{liminf (λn. ereal (Gromov_product_at e (u n) (v n))) |u v.
      abs_Gromov_completion u = x  abs_Gromov_completion v = y  Gromov_completion_rel u u  Gromov_completion_rel v v} =
      {liminf (λn. ereal (Gromov_product_at e (u n) (v n))) |u v.
      abs_Gromov_completion u = y  abs_Gromov_completion v = x  Gromov_completion_rel u u  Gromov_completion_rel v v}"
    by auto
qed

text ‹Inside the space, the extended distance and the extended Gromov product coincide with the
original ones.›

lemma extended_Gromov_distance_inside [simp]:
  "extended_Gromov_distance (to_Gromov_completion x) (to_Gromov_completion y) = dist x y"
unfolding extended_Gromov_distance_def Gromov_boundary_def by (auto simp add: to_Gromov_completion_inj)

lemma extended_Gromov_product_inside [simp] :
  "extended_Gromov_product_at e (to_Gromov_completion x) (to_Gromov_completion y) = Gromov_product_at e x y"
proof -
  have A: "u = (λn. z)" if H: "abs_Gromov_completion u = abs_Gromov_completion (λn. z)" "Gromov_completion_rel u u" for u and z::'a
  proof -
    have "Gromov_completion_rel u (λn. z)"
      apply (subst Quotient3_rel[OF Quotient3_Gromov_completion, symmetric])
      using H uniformity_dist_class_def by auto
    then show ?thesis using Gromov_completion_rel_to_const by auto
  qed
  then have *: "{u. abs_Gromov_completion u = to_Gromov_completion z  Gromov_completion_rel u u} = {(λn. z)}" for z::'a
    unfolding to_Gromov_completion_def by auto
  have **: "{F u v |u v. abs_Gromov_completion u = to_Gromov_completion x  abs_Gromov_completion v = to_Gromov_completion y  Gromov_completion_rel u u  Gromov_completion_rel v v}
      = {F (λn. x) (λn. y)}" for F::"(nat  'a)  (nat  'a)  ereal"
    using *[of x] *[of y] unfolding extended_Gromov_product_at_def by (auto, smt mem_Collect_eq singletonD)

  have "extended_Gromov_product_at e (to_Gromov_completion x) (to_Gromov_completion y) = Inf {liminf (λn. ereal(Gromov_product_at e ((λn. x) n) ((λn. y) n)))}"
    unfolding extended_Gromov_product_at_def ** by simp
  also have "... = ereal(Gromov_product_at e x y)"
    by (auto simp add: Liminf_const)
  finally show "extended_Gromov_product_at e (to_Gromov_completion x) (to_Gromov_completion y) = Gromov_product_at e x y"
    by simp
qed

text ‹A point in the boundary is at infinite extended distance of everyone, including itself:
the extended distance is obtained by taking the supremum along all sequences tending to this point,
so even for one single point one can take two sequences tending to it at different speeds, which
results in an infinite extended distance.›

lemma extended_Gromov_distance_PInf_boundary [simp]:
  assumes "x  Gromov_boundary"
  shows "extended_Gromov_distance x y = " "extended_Gromov_distance y x = "
unfolding extended_Gromov_distance_def using assms by auto

text ‹By construction, the extended distance still satisfies the triangle inequality.›

lemma extended_Gromov_distance_triangle [mono_intros]:
  "extended_Gromov_distance x z  extended_Gromov_distance x y + extended_Gromov_distance y z"
proof (cases "x  Gromov_boundary  y  Gromov_boundary  z  Gromov_boundary")
  case True
  then have *: "extended_Gromov_distance x y + extended_Gromov_distance y z = " by auto
  show ?thesis by (simp add: *)
next
  case False
  then obtain a b c where abc: "x = to_Gromov_completion a" "y = to_Gromov_completion b" "z = to_Gromov_completion c"
    unfolding Gromov_boundary_def by auto
  show ?thesis
    unfolding abc using dist_triangle[of a c b] ennreal_leI by fastforce
qed

text ‹The extended Gromov product can be bounded by the extended distance, just like inside
the space.›

lemma extended_Gromov_product_le_dist [mono_intros]:
  "extended_Gromov_product_at e x y  extended_Gromov_distance (to_Gromov_completion e) x"
proof (cases x)
  case boundary
  then show ?thesis by simp
next
  case (to_Gromov_completion a)
  define v where "v = rep_Gromov_completion y"
  have *: "abs_Gromov_completion (λn. a) = x  abs_Gromov_completion v = y  Gromov_completion_rel (λn. a) (λn. a)  Gromov_completion_rel v v"
    unfolding v_def to_Gromov_completion to_Gromov_completion_def
    by (auto simp add: Quotient3_rep_reflp[OF Quotient3_Gromov_completion] Quotient3_abs_rep[OF Quotient3_Gromov_completion])
  have "extended_Gromov_product_at e x y  liminf (λn. ereal(Gromov_product_at e a (v n)))"
    unfolding extended_Gromov_product_at_def apply (rule Inf_lower) using * by force
  also have "...  liminf (λn. ereal(dist e a))"
    using Gromov_product_le_dist(1)[of e a] by (auto intro!: Liminf_mono)
  also have "... = ereal(dist e a)"
    by (simp add: Liminf_const)
  also have "... = extended_Gromov_distance (to_Gromov_completion e) x"
    unfolding to_Gromov_completion by auto
  finally show ?thesis by auto
qed

lemma extended_Gromov_product_le_dist' [mono_intros]:
  "extended_Gromov_product_at e x y  extended_Gromov_distance (to_Gromov_completion e) y"
using extended_Gromov_product_le_dist[of e y x] by (simp add: extended_Gromov_product_at_commute)

text ‹The Gromov product inside the space varies by at most the distance when one varies one of
the points. We will need the same statement for the extended Gromov product. The proof is done
using this inequality inside the space, and passing to the limit.›

lemma extended_Gromov_product_at_diff3 [mono_intros]:
  "extended_Gromov_product_at e x y  extended_Gromov_product_at e x z + extended_Gromov_distance y z"
proof (cases "(extended_Gromov_distance y z = )  (extended_Gromov_product_at e x z = )")
  case False
  then have "y  Gromov_boundary" "z  Gromov_boundary"
    using extended_Gromov_distance_PInf_boundary by auto
  then obtain b c where b: "y = to_Gromov_completion b" and c: "z = to_Gromov_completion c"
    unfolding Gromov_boundary_def by auto
  have "extended_Gromov_distance y z = ereal(dist b c)"
    unfolding b c by auto
  have "extended_Gromov_product_at e x y  (extended_Gromov_product_at e x z + extended_Gromov_distance y z) + h" if "h>0" for h
  proof -
    have "t{liminf (λn. ereal(Gromov_product_at e (u n) (w n))) |u w. abs_Gromov_completion u = x
                   abs_Gromov_completion w = z  Gromov_completion_rel u u  Gromov_completion_rel w w}.
          t < extended_Gromov_product_at e x z + h"
      apply (subst Inf_less_iff[symmetric]) using False h > 0 extended_Gromov_product_nonneg[of e x z] unfolding extended_Gromov_product_at_def[symmetric]
      by (metis add.right_neutral ereal_add_left_cancel_less order_refl)
    then obtain u w where H: "abs_Gromov_completion u = x" "abs_Gromov_completion w = z"
                          "Gromov_completion_rel u u" "Gromov_completion_rel w w"
                          "liminf (λn. ereal(Gromov_product_at e (u n) (w n))) < extended_Gromov_product_at e x z + h"
      by auto
    then have w: "w n = c" for n
      using c Gromov_completion_rel_to_const Quotient3_Gromov_completion Quotient3_rel to_Gromov_completion_def by fastforce
    define v where v: "v = (λn::nat. b)"
    have "abs_Gromov_completion v = y" "Gromov_completion_rel v v"
      unfolding v by (auto simp add: b to_Gromov_completion_def)

    have "Gromov_product_at e (u n) (v n)  Gromov_product_at e (u n) (w n) + dist b c" for n
      unfolding v w using Gromov_product_at_diff3[of e "u n" b c] by auto
    then have *: "ereal(Gromov_product_at e (u n) (v n))  ereal(Gromov_product_at e (u n) (w n)) + extended_Gromov_distance y z" for n
      unfolding ‹extended_Gromov_distance y z = ereal(dist b c) by fastforce
    have "extended_Gromov_product_at e x y  liminf(λn. ereal(Gromov_product_at e (u n) (v n)))"
      unfolding extended_Gromov_product_at_def by (rule Inf_lower, auto, rule exI[of _ u], rule exI[of _ v], auto, fact+)
    also have "...  liminf(λn. ereal(Gromov_product_at e (u n) (w n)) + extended_Gromov_distance y z)"
      apply (rule Liminf_mono) using * unfolding eventually_sequentially by auto
    also have "... = liminf(λn. ereal(Gromov_product_at e (u n) (w n))) + extended_Gromov_distance y z"
      apply (rule Liminf_add_ereal_right) using False by auto
    also have "...  extended_Gromov_product_at e x z + h + extended_Gromov_distance y z"
      using less_imp_le[OF H(5)] by (auto intro: mono_intros)
    finally show ?thesis
      by (simp add: algebra_simps)
  qed
  then show ?thesis
    using ereal_le_epsilon by blast
next
  case True
  then show ?thesis by auto
qed

lemma extended_Gromov_product_at_diff2 [mono_intros]:
  "extended_Gromov_product_at e x y  extended_Gromov_product_at e z y + extended_Gromov_distance x z"
using extended_Gromov_product_at_diff3[of e y x z] by (simp add: extended_Gromov_product_at_commute)

lemma extended_Gromov_product_at_diff1 [mono_intros]:
  "extended_Gromov_product_at e x y  extended_Gromov_product_at f x y + dist e f"
proof (cases "extended_Gromov_product_at f x y = ")
  case False
  have "extended_Gromov_product_at e x y  (extended_Gromov_product_at f x y + dist e f) + h" if "h > 0" for h
  proof -
    have "t{liminf (λn. ereal(Gromov_product_at f (u n) (v n))) |u v. abs_Gromov_completion u = x
                 abs_Gromov_completion v = y  Gromov_completion_rel u u  Gromov_completion_rel v v}.
          t < extended_Gromov_product_at f x y + h"
      apply (subst Inf_less_iff[symmetric]) using False h > 0 extended_Gromov_product_nonneg[of f x y] unfolding extended_Gromov_product_at_def[symmetric]
      by (metis add.right_neutral ereal_add_left_cancel_less order_refl)
    then obtain u v where H: "abs_Gromov_completion u = x" "abs_Gromov_completion v = y"
                          "Gromov_completion_rel u u" "Gromov_completion_rel v v"
                          "liminf (λn. ereal(Gromov_product_at f (u n) (v n))) < extended_Gromov_product_at f x y + h"
      by auto

    have "Gromov_product_at e (u n) (v n)  Gromov_product_at f (u n) (v n) + dist e f" for n
      using Gromov_product_at_diff1[of e "u n" "v n" f] by auto
    then have *: "ereal(Gromov_product_at e (u n) (v n))  ereal(Gromov_product_at f (u n) (v n)) + dist e f" for n
      by fastforce
    have "extended_Gromov_product_at e x y  liminf(λn. ereal(Gromov_product_at e (u n) (v n)))"
      unfolding extended_Gromov_product_at_def by (rule Inf_lower, auto, rule exI[of _ u], rule exI[of _ v], auto, fact+)
    also have "...  liminf(λn. ereal(Gromov_product_at f (u n) (v n)) + dist e f)"
      apply (rule Liminf_mono) using * unfolding eventually_sequentially by auto
    also have "... = liminf(λn. ereal(Gromov_product_at f (u n) (v n))) + dist e f"
      apply (rule Liminf_add_ereal_right) using False by auto
    also have "...  extended_Gromov_product_at f x y + h + dist e f"
      using less_imp_le[OF H(5)] by (auto intro: mono_intros)
    finally show ?thesis
      by (simp add: algebra_simps)
  qed
  then show ?thesis
    using ereal_le_epsilon by blast
next
  case True
  then show ?thesis by auto
qed

text ‹A point in the Gromov boundary is represented by a sequence tending to infinity and
converging in the Gromov boundary, essentially by definition.›

lemma Gromov_boundary_abs_converging:
  assumes "x  Gromov_boundary" "abs_Gromov_completion u = x" "Gromov_completion_rel u u"
  shows "Gromov_converging_at_boundary u"
proof -
  have "Gromov_converging_at_boundary u  (m n. u n = u m)"
    using assms unfolding Gromov_completion_rel_def by auto
  moreover have "¬(m n. u n = u m)"
  proof (rule ccontr, simp)
    assume *: "m n. u n = u m"
    define z where "z = u 0"
    then have z: "u = (λn. z)"
      using * by auto
    then have "x = to_Gromov_completion z"
      using assms unfolding z to_Gromov_completion_def by auto
    then show False using x  Gromov_boundary› unfolding Gromov_boundary_def by auto
  qed
  ultimately show ?thesis by auto
qed

lemma Gromov_boundary_rep_converging:
  assumes "x  Gromov_boundary"
  shows "Gromov_converging_at_boundary (rep_Gromov_completion x)"
apply (rule Gromov_boundary_abs_converging[OF assms])
using Quotient3_Gromov_completion Quotient3_abs_rep Quotient3_rep_reflp by fastforce+

text ‹We can characterize the points for which the Gromov product is infinite: they have to be
the same point, at infinity. This is essentially equivalent to the definition of the Gromov
completion, but there is some boilerplate to get the proof working.›

lemma Gromov_boundary_extended_product_PInf [simp]:
  "extended_Gromov_product_at e x y =   (x  Gromov_boundary  y = x)"
proof
  fix x y::"'a Gromov_completion" assume "x  Gromov_boundary  y = x"
  then have H: "y = x" "x  Gromov_boundary" by auto
  have *: "liminf (λn. ereal (Gromov_product_at e (u n) (v n))) = " if
                  "abs_Gromov_completion u = x" "abs_Gromov_completion v = y"
                  "Gromov_completion_rel u u" "Gromov_completion_rel v v" for u v
  proof -
    have "Gromov_converging_at_boundary u" "Gromov_converging_at_boundary v"
      using Gromov_boundary_abs_converging that H by auto
    have "Gromov_completion_rel u v" using that y = x
      using Quotient3_rel[OF Quotient3_Gromov_completion] by fastforce
    then have "(λn. Gromov_product_at e (u n) (v n))  "
      unfolding Gromov_completion_rel_def using Gromov_converging_at_boundary_imp_not_constant'[OF ‹Gromov_converging_at_boundary u] by auto
    then show ?thesis
      by (simp add: tendsto_iff_Liminf_eq_Limsup)
  qed
  then show "extended_Gromov_product_at e x y = "
    unfolding extended_Gromov_product_at_def by (auto intro: Inf_eqI)
next
  fix x y::"'a Gromov_completion" assume H: "extended_Gromov_product_at e x y = "
  then have "extended_Gromov_distance (to_Gromov_completion e) x = "
    using extended_Gromov_product_le_dist[of e x y] neq_top_trans by auto
  then have "x  Gromov_boundary"
    by (metis ereal.distinct(1) extended_Gromov_distance_def infinity_ereal_def not_in_Gromov_boundary')
  have "extended_Gromov_distance (to_Gromov_completion e) y = "
    using extended_Gromov_product_le_dist[of e y x] neq_top_trans H by (auto simp add: extended_Gromov_product_at_commute)
  then have "y  Gromov_boundary"
    by (metis ereal.distinct(1) extended_Gromov_distance_def infinity_ereal_def not_in_Gromov_boundary')
  define u where "u = rep_Gromov_completion x"
  define v where "v = rep_Gromov_completion y"
  have A: "Gromov_converging_at_boundary u" "Gromov_converging_at_boundary v"
    unfolding u_def v_def using x  Gromov_boundary› y  Gromov_boundary›
    by (auto simp add: Gromov_boundary_rep_converging)

  have "abs_Gromov_completion u = x  abs_Gromov_completion v = y  Gromov_completion_rel u u  Gromov_completion_rel v v"
    unfolding u_def v_def
    using Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion] by auto
  then have "extended_Gromov_product_at e x y  liminf (λn. ereal(Gromov_product_at e (u n) (v n)))"
    unfolding extended_Gromov_product_at_def by (auto intro!: Inf_lower)
  then have "(λn. ereal(Gromov_product_at e (u n) (v n)))  "
    unfolding H by (simp add: liminf_PInfty)
  then have "(λn. ereal(Gromov_product_at a (u n) (v n)))  " for a
    using Gromov_product_tendsto_PInf_a_b by auto

  then have "Gromov_completion_rel u v"
    unfolding Gromov_completion_rel_def using A by auto
  then have "abs_Gromov_completion u = abs_Gromov_completion v"
    using Quotient3_rel_abs[OF Quotient3_Gromov_completion] by auto
  then have "x = y"
    unfolding u_def v_def Quotient3_abs_rep[OF Quotient3_Gromov_completion] by auto
  then show "x  Gromov_boundary  y = x"
    using x  Gromov_boundary› by auto
qed

text ‹As for points inside the space, we deduce that the extended Gromov product between $x$ and $x$
is just the extended distance to the basepoint.›

lemma extended_Gromov_product_e_x_x [simp]:
  "extended_Gromov_product_at e x x = extended_Gromov_distance (to_Gromov_completion e) x"
proof (cases x)
  case boundary
  then show ?thesis using Gromov_boundary_extended_product_PInf by auto
next
  case (to_Gromov_completion a)
  then show ?thesis by auto
qed

text ‹The inequality in terms of Gromov products characterizing hyperbolicity extends in the
same form to the Gromov completion, by taking limits of this inequality in the space.›

lemma extended_hyperb_ineq [mono_intros]:
  "extended_Gromov_product_at (e::'a::Gromov_hyperbolic_space) x z 
      min (extended_Gromov_product_at e x y) (extended_Gromov_product_at e y z) - deltaG(TYPE('a))"
proof -
  have "min (extended_Gromov_product_at e x y) (extended_Gromov_product_at e y z) - deltaG(TYPE('a)) 
    Inf {liminf (λn. ereal (Gromov_product_at e (u n) (v n))) |u v.
            abs_Gromov_completion u = x  abs_Gromov_completion v = z  Gromov_completion_rel u u  Gromov_completion_rel v v}"
  proof (rule cInf_greatest, auto)
    define u where "u = rep_Gromov_completion x"
    define w where "w = rep_Gromov_completion z"
    have "abs_Gromov_completion u = x  abs_Gromov_completion w = z  Gromov_completion_rel u u  Gromov_completion_rel w w"
      unfolding u_def w_def
      using Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion] by auto
    then show "t u. Gromov_completion_rel u u 
            (v. abs_Gromov_completion v = z  abs_Gromov_completion u = x  t = liminf (λn. ereal (Gromov_product_at e (u n) (v n)))  Gromov_completion_rel v v)"
      by auto
  next
    fix u w assume H: "x = abs_Gromov_completion u" "z = abs_Gromov_completion w"
                      "Gromov_completion_rel u u" "Gromov_completion_rel w w"
    define v where "v = rep_Gromov_completion y"
    have Y: "y = abs_Gromov_completion v" "Gromov_completion_rel v v"
      unfolding v_def
      by (auto simp add: Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion])

    have *: "min (ereal(Gromov_product_at e (u n) (v n))) (ereal(Gromov_product_at e (v n) (w n)))  ereal(Gromov_product_at e (u n) (w n)) + deltaG(TYPE('a))" for n
      by (subst ereal_min[symmetric], subst plus_ereal.simps(1), intro mono_intros)

    have "extended_Gromov_product_at e (abs_Gromov_completion u) y  liminf (λn. ereal(Gromov_product_at e (u n) (v n)))"
      unfolding extended_Gromov_product_at_def using Y H by (auto intro!: Inf_lower)
    moreover have "extended_Gromov_product_at e y (abs_Gromov_completion w)  liminf (λn. ereal(Gromov_product_at e (v n) (w n)))"
      unfolding extended_Gromov_product_at_def using Y H by (auto intro!: Inf_lower)
    ultimately have "min (extended_Gromov_product_at e (abs_Gromov_completion u) y) (extended_Gromov_product_at e y (abs_Gromov_completion w))
       min (liminf (λn. ereal(Gromov_product_at e (u n) (v n)))) (liminf (λn. ereal(Gromov_product_at e (v n) (w n))))"
      by (intro mono_intros, auto)
    also have "... = liminf (λn. min (ereal(Gromov_product_at e (u n) (v n))) (ereal(Gromov_product_at e (v n) (w n))))"
      by (rule Liminf_min_eq_min_Liminf[symmetric])
    also have "...  liminf (λn. ereal(Gromov_product_at e (u n) (w n)) + deltaG(TYPE('a)))"
      using * by (auto intro!: Liminf_mono)
    also have "... = liminf (λn. ereal(Gromov_product_at e (u n) (w n))) + deltaG(TYPE('a))"
      by (intro Liminf_add_ereal_right, auto)
    finally show "min (extended_Gromov_product_at e (abs_Gromov_completion u) y) (extended_Gromov_product_at e y (abs_Gromov_completion w))
                   liminf (λn. ereal (Gromov_product_at e (u n) (w n))) + ereal (deltaG TYPE('a))"
      by simp
  qed
  then show ?thesis unfolding extended_Gromov_product_at_def by auto
qed

lemma extended_hyperb_ineq' [mono_intros]:
  "extended_Gromov_product_at (e::'a::Gromov_hyperbolic_space) x z + deltaG(TYPE('a)) 
      min (extended_Gromov_product_at e x y) (extended_Gromov_product_at e y z)"
using extended_hyperb_ineq[of e x y z] unfolding ereal_minus_le_iff by (simp add: add.commute)

lemma zero_le_ereal [mono_intros]:
  assumes "0  z"
  shows "0  ereal z"
using assms by auto

lemma extended_hyperb_ineq_4_points' [mono_intros]:
  "Min {extended_Gromov_product_at (e::'a::Gromov_hyperbolic_space) x y, extended_Gromov_product_at e y z, extended_Gromov_product_at e z t}  extended_Gromov_product_at e x t + 2 * deltaG(TYPE('a))"
proof -
  have "min (extended_Gromov_product_at e x y + 0) (min (extended_Gromov_product_at e y z) (extended_Gromov_product_at e z t))
         min (extended_Gromov_product_at e x y + deltaG(TYPE('a))) (extended_Gromov_product_at e y t + deltaG(TYPE('a))) "
    by (intro mono_intros)
  also have "... = min (extended_Gromov_product_at e x y) (extended_Gromov_product_at e y t) + deltaG(TYPE('a))"
    by (simp add: add_mono_thms_linordered_semiring(3) dual_order.antisym min_def)
  also have "...  (extended_Gromov_product_at e x t + deltaG(TYPE('a))) + deltaG(TYPE('a))"
    by (intro mono_intros)
  finally show ?thesis apply (auto simp add: algebra_simps)
    by (metis (no_types, hide_lams) add.commute add.left_commute mult_2_right plus_ereal.simps(1))
qed

lemma extended_hyperb_ineq_4_points [mono_intros]:
  "Min {extended_Gromov_product_at (e::'a::Gromov_hyperbolic_space) x y, extended_Gromov_product_at e y z, extended_Gromov_product_at e z t} - 2 * deltaG(TYPE('a))  extended_Gromov_product_at e x t"
using extended_hyperb_ineq_4_points'[of e x y z] unfolding ereal_minus_le_iff by (simp add: add.commute)


subsection ‹Construction of the distance on the Gromov completion›

text ‹We want now to define the natural topology of the Gromov completion. Most textbooks
first define a topology on $\partial X$, or sometimes on
$X \cup \partial X$, and then much later a distance on $\partial X$ (but they never do the tedious
verification that the distance defines the same topology as the topology defined before). I have
not seen one textbook defining a distance on $X \cup \partial X$. It turns out that one can in fact
define a distance on $X \cup \partial X$, whose restriction to $\partial X$ is the usual distance
on the Gromov boundary, and define the topology of $X \cup \partial X$ using it. For formalization
purposes, this is very convenient as topologies defined with distances are automatically nice and
tractable (no need to check separation axioms, for instance). The price to pay is that, once
we have defined the distance, we have to check that it defines the right notion of convergence
one expects.

What we would like to take for the distance is
$d(x,y) = e^{-(x,y)_o}$, where $o$ is some fixed basepoint in the space. However, this
does not behave like a distance at small scales (but it is essentially the right thing at large
scales), and it does not really satisfy the triangle inequality. However, $e^{-\epsilon (x,y)_o}$
almost satisfies the triangle inequality if $\epsilon$ is small enough, i.e., it is equivalent
to a function satisfying the triangle inequality. This gives a genuine distance on the boundary,
but not inside the space as it does not vanish on pairs $(x,x)$.

A third try would be to take $d(x,y) = \min(\tilde d(x,y), e^{-\epsilon (x,y)_o})$ where
$\tilde d$ is the natural extension of $d$ to the Gromov completion (it is infinite if $x$ or $y$
belongs to the boundary). However, we can not prove that it is equivalent to a distance.

Finally, it works with $d(x,y) \asymp \min(\tilde d(x,y)^{1/2}, e^{-\epsilon (x,y)_o}$. This is
what we will prove below. To construct the distance, we use the results proved in
the locale \verb+Turn_into_distance+. For this, we need to check that our quasi-distance
satisfies a weird version of the triangular inequality.

All this construction depends on a basepoint, that we fix arbitrarily once and for all.
›

definition epsilonG::"('a::Gromov_hyperbolic_space) itself  real"
  where "epsilonG _ = ln 2 / (2+2*deltaG(TYPE('a)))"

definition basepoint::"'a"
  where "basepoint = (SOME a. True)"

lemma constant_in_extended_predist_pos [simp, mono_intros]:
  "epsilonG(TYPE('a::Gromov_hyperbolic_space)) > 0"
  "epsilonG(TYPE('a::Gromov_hyperbolic_space))  0"
  "ennreal (epsilonG(TYPE('a))) * top = top"
proof -
  have *: "2+2*deltaG(TYPE('a))  2 + 2 * 0"
    by (intro mono_intros, auto)
  show **: "epsilonG(TYPE('a)) > 0"
    unfolding epsilonG_def apply (auto simp add: divide_simps) using * by auto
  then show "ennreal (epsilonG(TYPE('a))) * top = top"
    using ennreal_mult_top by auto
  show "epsilonG(TYPE('a::Gromov_hyperbolic_space))  0"
    using ** by simp
qed

definition extended_predist::"('a::Gromov_hyperbolic_space) Gromov_completion  'a Gromov_completion  real"
  where "extended_predist x y = real_of_ereal (min (esqrt (extended_Gromov_distance x y))
          (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)))"

lemma extended_predist_ereal:
  "ereal (extended_predist x (y::('a::Gromov_hyperbolic_space) Gromov_completion)) = min (esqrt (extended_Gromov_distance x y))
          (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y))"
proof -
  have "eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)  eexp (0)"
    by (intro mono_intros, simp add: ereal_mult_le_0_iff)
  then have A: "min (esqrt (extended_Gromov_distance x y)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y))  1"
    unfolding min_def using order_trans by fastforce
  show ?thesis
    unfolding extended_predist_def apply (rule ereal_real') using A by auto
qed

lemma extended_predist_nonneg [simp, mono_intros]:
  "extended_predist x y  0"
unfolding extended_predist_def min_def by (auto intro: real_of_ereal_pos)

lemma extended_predist_commute:
  "extended_predist x y = extended_predist y x"
unfolding extended_predist_def by (simp add: extended_Gromov_distance_commute extended_Gromov_product_at_commute)

lemma extended_predist_self0 [simp]:
  "extended_predist x y = 0  x = y"
proof (auto)
  show "extended_predist y y = 0"
  proof (cases y)
    case boundary
    then have *: "extended_Gromov_product_at basepoint y y = "
      using Gromov_boundary_extended_product_PInf by auto
    show ?thesis unfolding extended_predist_def * apply (auto simp add: min_def)
      using constant_in_extended_predist_pos(1)[where ?'a = 'a] boundary by auto
  next
    case (to_Gromov_completion a)
    then show ?thesis unfolding extended_predist_def by (auto simp add: min_def)
  qed
  assume "extended_predist x y = 0"
  then have "esqrt (extended_Gromov_distance x y) = 0  eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y) = 0"
    by (metis extended_predist_ereal min_def zero_ereal_def)
    then show "x = y"
  proof
    assume "esqrt (extended_Gromov_distance x y) = 0"
    then have *: "extended_Gromov_distance x y = 0"
      using extended_Gromov_distance_nonneg by (metis ereal_zero_mult esqrt_square)
    then have "¬(x  Gromov_boundary)" "¬(y  Gromov_boundary)" by auto
    then obtain a b where ab: "x = to_Gromov_completion a" "y = to_Gromov_completion b"
      unfolding Gromov_boundary_def by auto
    have "a = b" using * unfolding ab by auto
    then show "x = y" using ab by auto
  next
    assume "eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y) = 0"
    then have "extended_Gromov_product_at basepoint x y = "
      by auto
    then show "x = y"
      using Gromov_boundary_extended_product_PInf[of basepoint x y] by auto
  qed
qed

lemma extended_predist_le1 [simp, mono_intros]:
  "extended_predist x y  1"
proof -
  have "eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)  eexp (0)"
    by (intro mono_intros, simp add: ereal_mult_le_0_iff)
  then have "min (esqrt (extended_Gromov_distance x y)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y))  1"
    unfolding min_def using order_trans by fastforce
  then show ?thesis
    unfolding extended_predist_def by (simp add: real_of_ereal_le_1)
qed

lemma extended_predist_weak_triangle:
  "extended_predist x z  sqrt 2 * max (extended_predist x y) (extended_predist y z)"
proof -
  have Z: "esqrt 2 = eexp (ereal(ln 2/2))"
    by (subst esqrt_eq_iff_square, auto simp add: exp_add[symmetric])

  have A: "eexp(ereal(epsilonG TYPE('a)) * 1)  esqrt 2"
    unfolding Z epsilonG_def apply auto
    apply (auto simp add: algebra_simps divide_simps intro!: mono_intros)
    using delta_nonneg[where ?'a = 'a] by auto

  text ‹We have to show an inequality $d(x, z) \leq \sqrt{2} \max(d(x,y), d(y,z))$. Each of $d(x,y)$
  and $d(y,z)$ is either the extended distance, or the exponential of minus the Gromov product,
  depending on which is smaller. We split according to the four cases.›

  have "(esqrt (extended_Gromov_distance x y)  eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)
         esqrt (extended_Gromov_distance x y)  eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y))
        
      ((esqrt (extended_Gromov_distance y z)  eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint y z)
         esqrt (extended_Gromov_distance y z)  eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint y z)))"
    by auto
  then have "ereal(extended_predist x z)  ereal (sqrt 2) * max (ereal(extended_predist x y)) (ereal (extended_predist y z))"
  proof (auto)

    text ‹First, consider the case where the minimum is the extended distance for both cases.
    Then $ed(x,z) \leq ed(x,y) + ed(y,z) \leq 2 \max(ed(x,y), ed(y,z))$. Therefore, $ed(x,z)^{1/2}
    \leq \sqrt{2} \max(ed(x,y)^{1/2}, ed(y,z)^{1/2})$. As predist is defined using
    the square root of $ed$, this readily gives the result.›
    assume H: "esqrt (extended_Gromov_distance x y)  eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint x y)"
              "esqrt (extended_Gromov_distance y z)  eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint y z)"
    have "extended_Gromov_distance x z  extended_Gromov_distance x y + extended_Gromov_distance y z"
      by (rule extended_Gromov_distance_triangle)
    also have "...  2 * max (extended_Gromov_distance x y) (extended_Gromov_distance y z)"
      by (simp add: add_mono add_mono_thms_linordered_semiring(1) mult_2_ereal)
    finally have "esqrt (extended_Gromov_distance x z)  esqrt (2 * max (extended_Gromov_distance x y) (extended_Gromov_distance y z))"
      by (intro mono_intros)
    also have "... = esqrt 2 * max (esqrt (extended_Gromov_distance x y)) (esqrt (extended_Gromov_distance y z))"
      by (auto simp add: esqrt_mult max_of_mono[OF esqrt_mono])
    finally show ?thesis unfolding extended_predist_ereal min_def using H by auto

  next
    text ‹Next, consider the case where the minimum comes from the Gromov product for both cases.
    Then, the conclusion will come for the hyperbolicity inequality (which is valid in the Gromov
    completion as well). There is an additive loss of $\delta$ in this inequality, which is converted
    to a multiplicative loss after taking the exponential to get the distance. Since, in the formula
    for the distance, the Gromov product is multiplied by a constant $\epsilon$ by design, the loss
    we get in the end is $\exp(\delta \epsilon)$. The precise value of $\epsilon$ we have taken is
    designed so that this is at most $\sqrt{2}$, giving the desired conclusion.›
    assume H: "eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint x y)  esqrt (extended_Gromov_distance x y)"
              "eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint y z)  esqrt (extended_Gromov_distance y z)"

    text ‹First, check that $\epsilon$ and $\delta$ satisfy the required inequality
    $\exp(\epsilon \delta) \leq \sqrt{2}$ (but in the extended reals as this is what we will use.›
    have B: "eexp (epsilonG(TYPE('a)) * deltaG(TYPE('a)))  esqrt 2"
      unfolding epsilonG_def ‹esqrt 2 = eexp (ereal(ln 2/2))
      apply (auto simp add: algebra_simps divide_simps intro!: mono_intros)
      using delta_nonneg[where ?'a = 'a] by auto

    text ‹We start the computation. First, use the hyperbolicity inequality.›
    have "eexp (- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x z)
       eexp (- epsilonG TYPE('a) * ((min (extended_Gromov_product_at basepoint x y) (extended_Gromov_product_at basepoint y z) - deltaG(TYPE('a)))))"
      apply (subst uminus_ereal.simps(1)[symmetric], subst ereal_mult_minus_left)+ by (intro mono_intros)
    text ‹Use distributivity to isolate the term $\epsilon \delta$. This requires some care
    as multiplication is not distributive in general in ereal.›
    also have "... = eexp (- epsilonG TYPE('a) * min (extended_Gromov_product_at basepoint x y) (extended_Gromov_product_at basepoint y z)
            + epsilonG TYPE('a) * deltaG TYPE('a))"
      apply (rule cong[of eexp], auto)
      apply (subst times_ereal.simps(1)[symmetric])
      apply (subst ereal_distrib_minus_left, auto)
      apply (subst uminus_ereal.simps(1)[symmetric])+
      apply (subst ereal_minus(6))
      by simp

    text ‹Use multiplicativity of exponential to extract the multiplicative error factor.›
    also have "... = eexp(- epsilonG TYPE('a) * (min (extended_Gromov_product_at basepoint x y) (extended_Gromov_product_at basepoint y z)))
                    * eexp(epsilonG(TYPE('a))* deltaG(TYPE('a)))"
      by (rule eexp_add_mult, auto)
    text ‹Extract the min outside of the exponential, using that all functions are monotonic.›
    also have "... = eexp(epsilonG(TYPE('a))* deltaG(TYPE('a)))
                    * (max (eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y))
                            (eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z)))"
      apply (subst max_of_antimono[of "λ (t::ereal). -epsilonG TYPE('a) * t", symmetric])
      apply (metis antimonoI constant_in_extended_predist_pos(2) enn2ereal_ennreal enn2ereal_nonneg ereal_minus_le_minus ereal_mult_left_mono ereal_mult_minus_left uminus_ereal.simps(1))
      apply (subst max_of_mono[OF eexp_mono])
      apply (simp add: mult.commute)
      done
    text ‹We recognize the distance of $x$ to $y$ and the distance from $y$ to $z$ on the right.›
    also have "... = eexp(epsilonG(TYPE('a)) * deltaG(TYPE('a))) * (max (ereal (extended_predist x y)) (extended_predist y z))"
      unfolding extended_predist_ereal min_def using H by auto
    also have "...  esqrt 2 * max (ereal(extended_predist x y)) (ereal(extended_predist y z))"
      apply (intro mono_intros B) using extended_predist_nonneg[of x y] by (simp add: max_def)
    finally show ?thesis unfolding extended_predist_ereal min_def by auto

  next
    text ‹Next consider the case where $d(x,y)$ comes from the exponential of minus the Gromov product,
    but $d(y,z)$ comes from their extended distance. Then $d(y,z) \leq 1$ (as $d(y,z)$ is smaller
    then the exponential of minus the Gromov distance, which is at most $1$), and this is all we use:
    the Gromov product between $x$ and $y$ or $x$ and $z$ differ by at most the distance from $y$ to $z$,
    i.e., $1$. Then the result follows directly as $\exp(\epsilon) \leq \sqrt{2}$, by the choice of
    $\epsilon$.›
    assume H: "eexp (- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y)  esqrt (extended_Gromov_distance x y)"
              "esqrt (extended_Gromov_distance y z)  eexp (- epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z)"
    then have "esqrt(extended_Gromov_distance y z)  1"
      by (auto intro!: order_trans[OF H(2)] simp add: ereal_mult_le_0_iff)
    then have "extended_Gromov_distance y z  1"
      by (metis eq_iff esqrt_mono2 esqrt_simps(2) esqrt_square extended_Gromov_distance_nonneg le_cases zero_less_one_ereal)

    have "ereal(extended_predist x z)  eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x z)"
      unfolding extended_predist_ereal min_def by auto
    also have "...  eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y
                          + epsilonG TYPE('a) * extended_Gromov_distance y z)"
      apply (intro mono_intros) apply (subst uminus_ereal.simps(1)[symmetric])+ apply (subst ereal_mult_minus_left)+
      apply (intro mono_intros)
      using extended_Gromov_product_at_diff3[of basepoint x y z]
      by (meson constant_in_extended_predist_pos(2) ereal_le_distrib ereal_mult_left_mono order_trans zero_le_ereal)
    also have "...  eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y + ereal(epsilonG TYPE('a)) * 1)"
      by (intro mono_intros, fact)
    also have "... = eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y) * eexp(ereal(epsilonG TYPE('a)) * 1)"
      by (rule eexp_add_mult, auto)
    also have "...  eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y) * esqrt 2"
      by (intro mono_intros A)
    also have "... = esqrt 2 * ereal(extended_predist x y)"
      unfolding extended_predist_ereal min_def using H by (auto simp add: mult.commute)
    also have "...  esqrt 2 * max (ereal(extended_predist x y)) (ereal(extended_predist y z))"
      unfolding max_def by (auto intro!: mono_intros)
    finally show ?thesis by auto

  next
    text ‹The last case is the symmetric of the previous one, and is proved similarly.›
    assume H: "eexp (- epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z)  esqrt (extended_Gromov_distance y z)"
              "esqrt (extended_Gromov_distance x y)  eexp (- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x y)"
    then have "esqrt(extended_Gromov_distance x y)  1"
      by (auto intro!: order_trans[OF H(2)] simp add: ereal_mult_le_0_iff)
    then have "extended_Gromov_distance x y  1"
      by (metis eq_iff esqrt_mono2 esqrt_simps(2) esqrt_square extended_Gromov_distance_nonneg le_cases zero_less_one_ereal)

    have "ereal(extended_predist x z)  eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint x z)"
      unfolding extended_predist_ereal min_def by auto
    also have "...  eexp(- epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z
                          + epsilonG TYPE('a) * extended_Gromov_distance x y)"
      apply (intro mono_intros) apply (subst uminus_ereal.simps(1)[symmetric])+ apply (subst ereal_mult_minus_left)+
      apply (intro mono_intros)
      using extended_Gromov_product_at_diff3[of basepoint z y x]
      apply (simp add: extended_Gromov_product_at_commute extended_Gromov_distance_commute)
      by (meson constant_in_extended_predist_pos(2) ereal_le_distrib ereal_mult_left_mono order_trans zero_le_ereal)
    also have "...  eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z + ereal(epsilonG TYPE('a)) * 1)"
      by (intro mono_intros, fact)
    also have "... = eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z) * eexp(ereal(epsilonG TYPE('a)) * 1)"
      by (rule eexp_add_mult, auto)
    also have "...  eexp(-epsilonG TYPE('a) * extended_Gromov_product_at basepoint y z) * esqrt 2"
      by (intro mono_intros A)
    also have "... = esqrt 2 * ereal(extended_predist y z)"
      unfolding extended_predist_ereal min_def using H by (auto simp add: mult.commute)
    also have "...  esqrt 2 * max (ereal(extended_predist x y)) (ereal(extended_predist y z))"
      unfolding max_def by (auto intro!: mono_intros)
    finally show ?thesis by auto
  qed
  then show "extended_predist x z  sqrt 2 * max (extended_predist x y) (extended_predist y z)"
    unfolding ereal_sqrt2[symmetric] max_of_mono[OF ereal_mono] times_ereal.simps(1) by auto
qed

instantiation Gromov_completion :: (Gromov_hyperbolic_space) metric_space
begin

definition dist_Gromov_completion::"('a::Gromov_hyperbolic_space) Gromov_completion  'a Gromov_completion  real"
  where "dist_Gromov_completion = turn_into_distance extended_predist"

text ‹To define a metric space in the current library of Isabelle/HOL, one should also introduce
a uniformity structure and a topology, as follows (they are prescribed by the distance):›

definition uniformity_Gromov_completion::"(('a Gromov_completion) × ('a Gromov_completion)) filter"
  where "uniformity_Gromov_completion = (INF e{0 <..}. principal {(x, y). dist x y < e})"

definition open_Gromov_completion :: "'a Gromov_completion set  bool"
  where "open_Gromov_completion U = (xU. eventually (λ(x', y). x' = x  y  U) uniformity)"

instance proof
  interpret Turn_into_distance extended_predist
    by (standard, auto intro: extended_predist_weak_triangle extended_predist_commute)
  fix x y z::"'a Gromov_completion"
  show "(dist x y = 0) = (x = y)"
    using TID_nonneg[of x y] lower[of x y] TID_self_zero upper[of x y] extended_predist_self0[of x y] unfolding dist_Gromov_completion_def
    by (auto, linarith)
  show "dist x y  dist x z + dist y z"
    unfolding dist_Gromov_completion_def using triangle by (simp add: TID_sym)
qed (auto simp add: uniformity_Gromov_completion_def open_Gromov_completion_def)
end

text ‹The only relevant property of the distance on the Gromov completion is that it is comparable
to the minimum of (the square root of) the extended distance, and the exponential of minus the Gromov
product. The precise formula we use to define it is just an implementation detail, in a sense.
We summarize these properties in the next theorem.
From this point on, we will only use this, and never come back to the definition based on
\verb+extended_predist+ and \verb+turn_into_distance+.›

theorem Gromov_completion_dist_comparison [mono_intros]:
  fixes x y::"('a::Gromov_hyperbolic_space) Gromov_completion"
  shows "ereal(dist x y)  esqrt(extended_Gromov_distance x y)"
        "ereal(dist x y)  eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)"
        "min (esqrt(extended_Gromov_distance x y)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y))  2 * ereal(dist x y)"
proof -
  interpret Turn_into_distance extended_predist
    by (standard, auto intro: extended_predist_weak_triangle extended_predist_commute)
  have "ereal(dist x y)  ereal(extended_predist x y)"
    unfolding dist_Gromov_completion_def by (auto intro!: upper mono_intros)
  then show "ereal(dist x y)  esqrt(extended_Gromov_distance x y)"
            "ereal(dist x y)  eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)"
    unfolding extended_predist_ereal by auto
  have "ereal(extended_predist x y)  ereal(2 * dist x y)"
    unfolding dist_Gromov_completion_def by (auto intro!: lower mono_intros)
  also have "... = 2 * ereal (dist x y)"
    by simp
  finally show "min (esqrt(extended_Gromov_distance x y)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y))  2 * ereal(dist x y)"
    unfolding extended_predist_ereal by auto
qed

lemma Gromov_completion_dist_le_1 [simp, mono_intros]:
  fixes x y::"('a::Gromov_hyperbolic_space) Gromov_completion"
  shows "dist x y  1"
proof -
  have "ereal(dist x y)  eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)"
    using Gromov_completion_dist_comparison(2)[of x y] by simp
  also have "...  eexp(-0)"
    by (intro mono_intros) (simp add: ereal_mult_le_0_iff)
  finally show ?thesis
    by auto
qed

text ‹To avoid computations with exponentials, the following lemma is very convenient. It asserts
that if $x$ is close enough to infinity, and $y$ is close enough to $x$, then the Gromov product
between $x$ and $y$ is large.›

lemma large_Gromov_product_approx:
  assumes "(M::ereal) < "
  shows "e D. e > 0  D <   (x y. dist x y  e  extended_Gromov_distance x (to_Gromov_completion basepoint)  D  extended_Gromov_product_at basepoint x y  M)"
proof -
  obtain M0::real where "M  ereal M0" using assms by (cases M, auto)
  define e::real where "e = exp(-epsilonG(TYPE('a)) * M0)/2"
  define D::ereal where "D = ereal M0 + 4"
  have "e > 0"
    unfolding e_def by auto
  moreover have "D < "
    unfolding D_def by auto
  moreover have "extended_Gromov_product_at basepoint x y  M0"
    if "dist x y  e" "extended_Gromov_distance x (to_Gromov_completion basepoint)  D" for x y::"'a Gromov_completion"
  proof (cases "esqrt(extended_Gromov_distance x y)  eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)")
    case False
    then have "eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)  2 * ereal(dist x y)"
      using Gromov_completion_dist_comparison(3)[of x y] unfolding min_def by auto
    also have "...  exp(-epsilonG(TYPE('a)) * M0)"
      using ‹dist x y  e unfolding e_def by (auto simp add: numeral_mult_ennreal)
    finally have "ereal M0  extended_Gromov_product_at basepoint x y"
      unfolding eexp_ereal[symmetric] apply (simp only: eexp_le_eexp_iff_le)
      unfolding times_ereal.simps(1)[symmetric] uminus_ereal.simps(1)[symmetric] ereal_mult_minus_left ereal_minus_le_minus
      using ereal_mult_le_mult_iff[of "ereal (epsilonG TYPE('a))"] apply auto
      by (metis r p. ereal (r * p) = ereal r * ereal p)
    then show "M0  extended_Gromov_product_at basepoint x y"
      by auto
  next
    case True
    then have "esqrt(extended_Gromov_distance x y)  2 * ereal(dist x y)"
      using Gromov_completion_dist_comparison(3)[of x y] unfolding min_def by auto
    also have "...  esqrt 4"
      by simp
    finally have *: "extended_Gromov_distance x y  4"
      unfolding esqrt_le using antisym by fastforce
    have "ereal M0+4  D"
      unfolding D_def by auto
    also have "...  extended_Gromov_product_at basepoint x x"
      using that by (auto simp add: extended_Gromov_distance_commute)
    also have "...  extended_Gromov_product_at basepoint x y + extended_Gromov_distance x y"
      by (rule extended_Gromov_product_at_diff3[of basepoint x x y])
    also have "...  extended_Gromov_product_at basepoint x y + 4"
      by (intro mono_intros *)
    finally show "M0  extended_Gromov_product_at basepoint x y"
      by (metis (no_types, lifting) PInfty_neq_ereal(1) add.commute add_nonneg_nonneg ereal_add_strict_mono ereal_le_distrib mult_2_ereal not_le numeral_Bit0 numeral_eq_ereal one_add_one zero_less_one_ereal)
  qed
  ultimately show ?thesis using order_trans[OF M  ereal M0] by force
qed

text ‹On the other hand, far away from infinity, it is equivalent to control the extended Gromov
distance or the new distance on the space.›

lemma inside_Gromov_distance_approx:
  assumes "C < (::ereal)"
  shows "e > 0. x y. extended_Gromov_distance (to_Gromov_completion basepoint) x  C  dist x y  e
           esqrt(extended_Gromov_distance x y)  2 * ereal(dist x y)"
proof -
  obtain C0 where "C  ereal C0" using assms by (cases C, auto)
  define e0 where "e0 = exp(-epsilonG(TYPE('a)) * C0)"
  have "e0 > 0"
    unfolding e0_def using assms by auto
  define e where "e = e0/4"
  have "e > 0"
    unfolding e_def using e0 > 0 by auto
  moreover have "esqrt(extended_Gromov_distance x y)  2 * ereal(dist x y)"
    if "extended_Gromov_distance (to_Gromov_completion basepoint) x  C0" "dist x y  e" for x y::"'a Gromov_completion"
  proof -
    have R: "min a b  c  a  c  b  c" for a b c::ereal unfolding min_def
      by presburger
    have "2 * ereal (dist x y)  2 * ereal e"
      using that by (intro mono_intros, auto)
    also have "... = ereal(e0/2)"
      unfolding e_def by auto
    also have "... < ereal e0"
      apply (intro mono_intros) using e0 > 0 by auto
    also have "...  eexp(-epsilonG(TYPE('a)) * extended_Gromov_distance (to_Gromov_completion basepoint) x)"
      unfolding e0_def eexp_ereal[symmetric] ereal_mult_minus_left mult_minus_left uminus_ereal.simps(1)[symmetric] times_ereal.simps(1)[symmetric]
      by (intro mono_intros that)
    also have "...  eexp(-epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint x y)"
      unfolding ereal_mult_minus_left mult_minus_left uminus_ereal.simps(1)[symmetric] times_ereal.simps(1)[symmetric]
      by (intro mono_intros)
    finally show ?thesis
      using R[OF Gromov_completion_dist_comparison(3)[of x y]] by auto
  qed
  ultimately show ?thesis using order_trans[OF _ C  ereal C0] by auto
qed


subsection ‹Characterizing convergence in the Gromov boundary›

text ‹The convergence of sequences in the Gromov boundary can be characterized, essentially
by definition: sequences tend to a point at infinity iff the Gromov product with this point tends
to infinity, while sequences tend to a point inside iff the extended distance tends to $0$. In both
cases, it is just a matter of unfolding the definition of the distance, and see which one of the two
terms (exponential of minus the Gromov product, or extended distance) realizes the minimum. We have
constructed the distance essentially so that this property is satisfied.

We could also have defined first the topology, satisfying these conditions, but then we would have
had to check that it coincides with the topology that the distance defines, so it seems more
economical to proceed in this way.›

lemma Gromov_completion_boundary_limit:
  assumes "x  Gromov_boundary"
  shows "(u  x) F  ((λn. extended_Gromov_product_at basepoint (u n) x)  ) F"
proof
  assume *: "((λn. extended_Gromov_product_at basepoint (u n) x)  ) F"
  have "((λn. ereal(dist (u n) x))  0) F"
  proof (rule tendsto_sandwich[of "λ_. 0" _ _ "(λn. eexp (-epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))"])
    have "((λn. eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))  eexp (- epsilonG(TYPE('a)) * (::ereal))) F"
      apply (intro tendsto_intros *) by auto
    then show "((λn. eexp (-epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))  0) F"
      using constant_in_extended_predist_pos(1)[where ?'a = 'a] by auto
  qed (auto simp add: Gromov_completion_dist_comparison)
  then have "((λn. real_of_ereal(ereal(dist (u n) x)))  0) F"
    by (simp add: zero_ereal_def)
  then show "(u  x) F"
    by (subst tendsto_dist_iff, auto)
next
  assume *: "(u  x) F"
  have A: "1 / ereal (- epsilonG TYPE('a)) * (ereal (- epsilonG TYPE('a))) = 1"
    apply auto using constant_in_extended_predist_pos(1)[where ?'a = 'a] by auto
  have a: "esqrt(extended_Gromov_distance (u n) x) = " for n
    unfolding extended_Gromov_distance_PInf_boundary(2)[OF assms, of "u n"] by auto
  have "min (esqrt(extended_Gromov_distance (u n) x)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))
        = eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x)" for n
    unfolding a min_def using neq_top_trans by force
  moreover have "((λn. min (esqrt(extended_Gromov_distance (u n) x)) (eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x)))  0) F"
  proof (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. 2 * ereal(dist (u n) x)"])
    have "((λn. 2 * ereal (dist (u n) x))  2 * ereal 0) F"
      apply (intro tendsto_intros) using * tendsto_dist_iff by auto
    then show "((λn. 2 * ereal (dist (u n) x))  0) F" by (simp add: zero_ereal_def)
    show "F n in F. 0  min (esqrt (extended_Gromov_distance (u n) x)) (eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))"
      by (rule always_eventually, auto)
    show "F n in F.
        min (esqrt (extended_Gromov_distance (u n) x)) (eexp (ereal (- epsilonG TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))  2 * ereal (dist (u n) x)"
      apply (rule always_eventually) using Gromov_completion_dist_comparison(3) by auto
  qed (auto)
  ultimately have "((λn. eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))  0) F"
    by auto
  then have "((λn. - epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x)  -) F"
    unfolding eexp_special_values(3)[symmetric] eexp_tendsto' by auto
  then have "((λn. 1/ereal(-epsilonG(TYPE('a))) * (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (u n) x))  1/ereal(-epsilonG(TYPE('a))) * (-)) F"
    by (intro tendsto_intros, auto)
  moreover have "1/ereal(-epsilonG(TYPE('a))) * (-) = "
    apply auto using constant_in_extended_predist_pos(1)[where ?'a = 'a] by auto
  ultimately show "((λn. extended_Gromov_product_at basepoint (u n) x)  ) F"
    unfolding ab_semigroup_mult_class.mult_ac(1)[symmetric] A by auto
qed

lemma extended_Gromov_product_tendsto_PInf_a_b:
  assumes "((λn. extended_Gromov_product_at a (u n) (v n))  ) F"
  shows "((λn. extended_Gromov_product_at b (u n) (v n))  ) F"
proof (rule tendsto_sandwich[of "λn. extended_Gromov_product_at a (u n) (v n) - dist a b" _ _ "λ_. "])
  have "extended_Gromov_product_at a (u n) (v n) - ereal (dist a b)  extended_Gromov_product_at b (u n) (v n)" for n
    using extended_Gromov_product_at_diff1[of a "u n" "v n" b] by (simp add: add.commute ereal_minus_le_iff)
  then show "F n in F. extended_Gromov_product_at a (u n) (v n) - ereal (dist a b)  extended_Gromov_product_at b (u n) (v n)"
    by auto
  have "((λn. extended_Gromov_product_at a (u n) (v n) - ereal (dist a b))   - ereal (dist a b)) F"
    by (intro tendsto_intros assms) auto
  then show "((λn. extended_Gromov_product_at a (u n) (v n) - ereal (dist a b))  ) F"
    by auto
qed (auto)

lemma Gromov_completion_inside_limit:
  assumes "x  Gromov_boundary"
  shows "(u  x) F  ((λn. extended_Gromov_distance (u n) x)  0) F"
proof
  assume *: "((λn. extended_Gromov_distance (u n) x)  0) F"
  have "((λn. ereal(dist (u n) x))  ereal 0) F"
  proof (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. esqrt (extended_Gromov_distance (u n) x)"])
    have "((λn. esqrt (extended_Gromov_distance (u n) x))  esqrt 0) F"
      by (intro tendsto_intros *)
    then show "((λn. esqrt (extended_Gromov_distance (u n) x))  ereal 0) F"
      by (simp add: zero_ereal_def)
  qed (auto simp add: Gromov_completion_dist_comparison zero_ereal_def)
  then have "((λn. real_of_ereal(ereal(dist (u n) x)))  0) F"
    by (intro lim_real_of_ereal)
  then show "(u  x) F"
    by (subst tendsto_dist_iff, auto)
next
  assume *: "(u  x) F"
  have "x  range to_Gromov_completion" using assms unfolding Gromov_boundary_def by auto
  have "((λn. esqrt(extended_Gromov_distance (u n) x))  0) F"
  proof (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. 2 * ereal(dist (u n) x)"])
    have A: "extended_Gromov_distance (to_Gromov_completion basepoint) x < "
      by (simp add: assms extended_Gromov_distance_def)
    obtain e where e: "e > 0" "y. dist x y  e  esqrt(extended_Gromov_distance x y)  2 * ereal (dist x y)"
      using inside_Gromov_distance_approx[OF A] by auto
    have B: "eventually (λn. dist x (u n) < e) F"
      using order_tendstoD(2)[OF iffD1[OF tendsto_dist_iff *] e > 0] by (simp add: dist_commute)
    then have "eventually (λn. esqrt(extended_Gromov_distance x (u n))  2 * ereal (dist x (u n))) F"
      using eventually_mono[OF _ e(2)] less_imp_le by (metis (mono_tags, lifting))
    then show "eventually (λn. esqrt(extended_Gromov_distance (u n) x)  2 * ereal (dist (u n) x)) F"
      by (simp add: dist_commute extended_Gromov_distance_commute)
    have "((λn. 2 * ereal(dist (u n) x))  2 * ereal 0) F"
      apply (intro tendsto_intros) using tendsto_dist_iff * by auto
    then show "((λn. 2 * ereal(dist (u n) x))  0) F"
      by (simp add: zero_ereal_def)
  qed (auto)
  then have "((λn. esqrt(extended_Gromov_distance (u n) x) * esqrt(extended_Gromov_distance (u n) x))  0 * 0) F"
    by (intro tendsto_intros, auto)
  then show "((λn. extended_Gromov_distance (u n) x)  0) F"
    by auto
qed

lemma to_Gromov_completion_lim [simp, tendsto_intros]:
  "((λn. to_Gromov_completion (u n))  to_Gromov_completion a) F  (u  a) F"
proof (subst Gromov_completion_inside_limit, auto)
  assume "((λn. ereal (dist (u n) a))  0) F"
  then have "((λn. real_of_ereal(ereal (dist (u n) a)))  0) F"
    unfolding zero_ereal_def by (rule lim_real_of_ereal)
  then show "(u  a) F"
    by (subst tendsto_dist_iff, auto)
next
  assume "(u  a) F"
  then have "((λn. dist (u n) a)  0) F"
    using tendsto_dist_iff by auto
  then show "((λn. ereal (dist (u n) a))  0) F"
    unfolding zero_ereal_def by (intro tendsto_intros)
qed

text ‹Now, we can also come back to our original definition of the completion, where points on the
boundary correspond to equivalence classes of sequences whose mutual Gromov product tends to
infinity. We show that this is compatible with our topology: the sequences that are in the equivalence
class of a point on the boundary are exactly the sequences that converge to this point. This is also
a direct consequence of the definitions, although the proof requires some unfolding (and playing
with the hyperbolicity inequality several times).›

text ‹First, we show that a sequence in the equivalence class of $x$ converges to $x$.›

lemma Gromov_completion_converge_to_boundary_aux:
  assumes "x  Gromov_boundary" "abs_Gromov_completion v = x" "Gromov_completion_rel v v"
  shows "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x)  "
proof -
  have A: "eventually (λn. extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x  ereal M) sequentially" for M
  proof -
    have "Gromov_converging_at_boundary v"
      using Gromov_boundary_abs_converging assms by blast
    then obtain N where N: "m n. m  N  n  N  Gromov_product_at basepoint (v m) (v n)  M + deltaG(TYPE('a))"
      unfolding Gromov_converging_at_boundary_def by metis
    have "extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x  ereal M" if "n  N" for n
    unfolding extended_Gromov_product_at_def proof (rule Inf_greatest, auto)
      fix wv wx assume H: "abs_Gromov_completion wv = to_Gromov_completion (v n)"
                          "x = abs_Gromov_completion wx"
                          "Gromov_completion_rel wv wv" "Gromov_completion_rel wx wx"
      then have wv: "wv p = v n" for p
        using Gromov_completion_rel_to_const Quotient3_Gromov_completion Quotient3_rel to_Gromov_completion_def by fastforce
      have "Gromov_completion_rel v wx"
        using assms H Quotient3_rel[OF Quotient3_Gromov_completion] by auto
      then have *: "(λp. Gromov_product_at basepoint (v p) (wx p))  "
        unfolding Gromov_completion_rel_def using Gromov_converging_at_boundary_imp_not_constant' ‹Gromov_converging_at_boundary v by auto
      have "eventually (λp. ereal(Gromov_product_at basepoint (v p) (wx p)) > M + deltaG(TYPE('a))) sequentially"
        using order_tendstoD[OF *, of "ereal (M + deltaG TYPE('a))"] by auto
      then obtain P where P: "p. p  P  ereal(Gromov_product_at basepoint (v p) (wx p)) > M + deltaG(TYPE('a))"
        unfolding eventually_sequentially by auto
      have *: "ereal (Gromov_product_at basepoint (v n) (wx p))  ereal M" if "p  max P N" for p
      proof (intro mono_intros)
        have "M  min (M + deltaG(TYPE('a))) (M + deltaG(TYPE('a))) - deltaG(TYPE('a))"
          by auto
        also have "...  min (Gromov_product_at basepoint (v n) (v p)) (Gromov_product_at basepoint (v p) (wx p)) - deltaG(TYPE('a))"
          apply (intro mono_intros)
          using N[OF n  N, of p] p  max P N P[of p] p  max P N by auto
        also have "...  Gromov_product_at basepoint (v n) (wx p) "
          by (rule hyperb_ineq)
        finally show "M  Gromov_product_at basepoint (v n) (wx p) "
          by simp
      qed
      then have "eventually (λp. ereal (Gromov_product_at basepoint (v n) (wx p))  ereal M) sequentially"
        unfolding eventually_sequentially by metis
      then show "ereal M  liminf (λp. ereal (Gromov_product_at basepoint (wv p) (wx p)))"
        unfolding wv by (simp add: Liminf_bounded)
    qed
    then show ?thesis unfolding eventually_sequentially by auto
  qed
  have B: "eventually (λn. extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x > M) sequentially" if "M < " for M
  proof -
    obtain N where "ereal N > M" using M <  ereal_dense2 by auto
    then have "a  ereal N  a > M" for a by auto
    then show ?thesis using A[of N] eventually_elim2 by force
  qed
  then show ?thesis
    by (rule order_tendstoI, auto)
qed

text ‹Then, we prove the converse and therefore the equivalence.›

lemma Gromov_completion_converge_to_boundary:
  assumes "x  Gromov_boundary"
  shows "((λn. to_Gromov_completion (u n))  x)  (Gromov_completion_rel u u  abs_Gromov_completion u = x)"
proof
  assume "Gromov_completion_rel u u  abs_Gromov_completion u = x"
  then show "((λn. to_Gromov_completion(u n))  x)"
    using Gromov_completion_converge_to_boundary_aux[OF assms, of u] unfolding Gromov_completion_boundary_limit[OF assms] by auto
next
  assume H: "(λn. to_Gromov_completion (u n))  x"
  have Lu: "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x)  "
    using iffD1[OF Gromov_completion_boundary_limit[OF assms] H] by simp
  have A: "N. n  N.  m  N. Gromov_product_at basepoint (u m) (u n)  M" for M
  proof -
    have "eventually (λn. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x > M + deltaG(TYPE('a))) sequentially"
      by (rule order_tendstoD[OF Lu], auto)
    then obtain N where N: "n. n  N  extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x > M + deltaG(TYPE('a))"
      unfolding eventually_sequentially by auto
    have "Gromov_product_at basepoint (u m) (u n)  M" if "n  N" "m  N" for m n
    proof -
      have "ereal M  min (ereal (M + deltaG(TYPE('a)))) (ereal (M + deltaG(TYPE('a)))) - ereal(deltaG(TYPE('a)))"
        by simp
      also have "...  min (extended_Gromov_product_at basepoint (to_Gromov_completion (u m)) x) (extended_Gromov_product_at basepoint x (to_Gromov_completion (u n))) - deltaG(TYPE('a))"
        apply (intro mono_intros) using N[OF n  N] N[OF m  N]
        by (auto simp add: extended_Gromov_product_at_commute)
      also have "...  extended_Gromov_product_at basepoint (to_Gromov_completion (u m)) (to_Gromov_completion (u n))"
        by (rule extended_hyperb_ineq)
      finally show ?thesis by auto
    qed
    then show ?thesis by auto
  qed
  have "N. n  N.  m  N. Gromov_product_at a (u m) (u n)  M" for M a
  proof -
    obtain N where N: "m n. m  N  n  N  Gromov_product_at basepoint (u m) (u n)  M + dist a basepoint"
      using A[of "M + dist a basepoint"] by auto
    have "Gromov_product_at a (u m) (u n)  M" if "m  N" "n  N" for m n
      using N[OF that] Gromov_product_at_diff1[of a "u m" "u n" basepoint] by auto
    then show ?thesis by auto
  qed
  then have "Gromov_converging_at_boundary u"
    unfolding Gromov_converging_at_boundary_def by auto
  then have "Gromov_completion_rel u u" using Gromov_converging_at_boundary_rel by auto

  define v where "v = rep_Gromov_completion x"
  then have "Gromov_converging_at_boundary v"
    using Gromov_boundary_rep_converging[OF assms] by auto
  have v: "abs_Gromov_completion v = x" "Gromov_completion_rel v v"
    using Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion]
    unfolding v_def by auto
  then have Lv: "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x)  "
    using Gromov_completion_converge_to_boundary_aux[OF assms] by auto

  have *: "(λn. min (extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x) (extended_Gromov_product_at basepoint x (to_Gromov_completion (v n))) -
          ereal (deltaG TYPE('a)))  min   - ereal (deltaG TYPE('a))"
    apply (intro tendsto_intros) using Lu Lv by (auto simp add: extended_Gromov_product_at_commute)
  have "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) (to_Gromov_completion (v n)))  "
    apply (rule tendsto_sandwich[of "λn. min (extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x)
                                              (extended_Gromov_product_at basepoint x (to_Gromov_completion (v n))) - deltaG(TYPE('a))" _ _ "λ_. "])
    using extended_hyperb_ineq not_eventuallyD apply blast using * by auto
  then have "(λn. Gromov_product_at basepoint (u n) (v n))  "
    by auto
  then have "(λn. Gromov_product_at a (u n) (v n))  " for a
    using Gromov_product_tendsto_PInf_a_b by auto
  then have "Gromov_completion_rel u v"
    unfolding Gromov_completion_rel_def
    using ‹Gromov_converging_at_boundary u ‹Gromov_converging_at_boundary v by auto
  then have "abs_Gromov_completion u = abs_Gromov_completion v"
    using Quotient3_rel[OF Quotient3_Gromov_completion] v(2) ‹Gromov_completion_rel u u by auto
  then have "abs_Gromov_completion u = x"
    using v(1) by auto
  then show "Gromov_completion_rel u u  abs_Gromov_completion u = x"
    using ‹Gromov_completion_rel u u by auto
qed

text ‹In particular, it follows that a sequence which is \verb+Gromov_converging_at_boundary+ is
indeed converging to a point on the boundary, the equivalence class of this sequence.›

lemma Gromov_converging_at_boundary_converges:
  assumes "Gromov_converging_at_boundary u"
  shows "x  Gromov_boundary. (λn. to_Gromov_completion (u n))  x"
apply (rule bexI[of _ "abs_Gromov_completion u"])
apply (subst Gromov_completion_converge_to_boundary)
using assms by (auto simp add: Gromov_converging_at_boundary_rel)

lemma Gromov_converging_at_boundary_converges':
  assumes "Gromov_converging_at_boundary u"
  shows "convergent (λn. to_Gromov_completion (u n))"
unfolding convergent_def using Gromov_converging_at_boundary_converges[OF assms] by auto

lemma lim_imp_Gromov_converging_at_boundary:
  fixes u::"nat  'a::Gromov_hyperbolic_space"
  assumes "(λn. to_Gromov_completion (u n))  x" "x  Gromov_boundary"
  shows "Gromov_converging_at_boundary u"
using Gromov_boundary_abs_converging Gromov_completion_converge_to_boundary assms by blast

text ‹If two sequences tend to the same point at infinity, then their Gromov product tends to
infinity.›

lemma same_limit_imp_Gromov_product_tendsto_infinity:
  assumes "z  Gromov_boundary"
          "(λn. to_Gromov_completion (u n))  z"
          "(λn. to_Gromov_completion (v n))  z"
  shows "N. n  N. m  N. Gromov_product_at a (u n) (v m)  C"
proof -
  have "Gromov_completion_rel u u" "Gromov_completion_rel v v" "abs_Gromov_completion u = abs_Gromov_completion v"
    using iffD1[OF Gromov_completion_converge_to_boundary[OF assms(1)]] assms by auto
  then have *: "Gromov_completion_rel u v"
    using Quotient3_Gromov_completion Quotient3_rel by fastforce
  have **: "Gromov_converging_at_boundary u"
    using assms lim_imp_Gromov_converging_at_boundary by blast
  then obtain M where M: "m n. m  M  n  M  Gromov_product_at a (u m) (u n)  C + deltaG(TYPE('a))"
    unfolding Gromov_converging_at_boundary_def by blast

  have "(λn. Gromov_product_at a (u n) (v n))  "
    using * Gromov_converging_at_boundary_imp_not_constant'[OF **] unfolding Gromov_completion_rel_def by auto
  then have "eventually (λn. Gromov_product_at a (u n) (v n)  C + deltaG(TYPE('a))) sequentially"
    by (meson Lim_PInfty ereal_less_eq(3) eventually_sequentiallyI)
  then obtain N where N: "n. n  N  Gromov_product_at a (u n) (v n)  C + deltaG(TYPE('a))"
    unfolding eventually_sequentially by auto
  have "Gromov_product_at a (u n) (v m)  C" if "n  max M N" "m  max M N" for m n
  proof -
    have "C + deltaG(TYPE('a))  min (Gromov_product_at a (u n) (u m)) (Gromov_product_at a (u m) (v m))"
      using M N that by auto
    also have "...  Gromov_product_at a (u n) (v m) + deltaG(TYPE('a))"
      by (intro mono_intros)
    finally show ?thesis by simp
  qed
  then show ?thesis
    by blast
qed

text ‹An admissible sequence converges in the Gromov boundary, to the point it defines. This
follows from the definition of the topology in the two cases, inner and boundary.›

lemma abs_Gromov_completion_limit:
  assumes "Gromov_completion_rel u u"
  shows "(λn. to_Gromov_completion (u n))  abs_Gromov_completion u"
proof (cases "abs_Gromov_completion u")
  case (to_Gromov_completion x)
  then show ?thesis
    using Gromov_completion_rel_to_const Quotient3_Gromov_completion Quotient3_rel assms to_Gromov_completion_def by fastforce
next
  case boundary
  show ?thesis
    unfolding Gromov_completion_converge_to_boundary[OF boundary]
    using assms Gromov_boundary_rep_converging Gromov_converging_at_boundary_rel Quotient3_Gromov_completion Quotient3_abs_rep boundary by fastforce
qed

text ‹In particular, a point in the Gromov boundary is the limit of
its representative sequence in the space.›

lemma rep_Gromov_completion_limit:
  "(λn. to_Gromov_completion (rep_Gromov_completion x n))  x"
using abs_Gromov_completion_limit[of "rep_Gromov_completion x"] Quotient3_Gromov_completion Quotient3_abs_rep Quotient3_rep_reflp by fastforce


subsection ‹Continuity properties of the extended Gromov product and distance›

text ‹We have defined our extended Gromov product in terms of sequences satisfying the equivalence
relation. However, we would like to avoid this definition as much as possible, and express things
in terms of the topology of the space. Hence, we reformulate this definition in topological terms,
first when one of the two points is inside and the other one is on the boundary, then for all
cases, and then we come back to the case where one point is inside, removing the assumption that
the other one is on the boundary.›

lemma extended_Gromov_product_inside_boundary_aux:
  assumes "y  Gromov_boundary"
  shows "extended_Gromov_product_at e (to_Gromov_completion x) y = Inf {liminf (λn. ereal(Gromov_product_at e x (v n))) |v. (λn. to_Gromov_completion (v n))  y}"
proof -
  have A: "abs_Gromov_completion v = to_Gromov_completion x  Gromov_completion_rel v v  (v = (λn. x))" for v
    apply (auto simp add: to_Gromov_completion_def)
    by (metis (mono_tags) Gromov_completion_rel_def Quotient3_Gromov_completion abs_Gromov_completion_in_Gromov_boundary not_in_Gromov_boundary' rep_Gromov_completion_to_Gromov_completion rep_abs_rsp to_Gromov_completion_def)
  have *: "{F u v |u v. abs_Gromov_completion u = to_Gromov_completion x  abs_Gromov_completion v = y  Gromov_completion_rel u u  Gromov_completion_rel v v}
      = {F (λn. x) v |v. (λn. to_Gromov_completion (v n))  y}" for F::"(nat  'a)  (nat  'a)  ereal"
    unfolding Gromov_completion_converge_to_boundary[OF y  Gromov_boundary›] using A by force
  show ?thesis
    unfolding extended_Gromov_product_at_def * by simp
qed

lemma extended_Gromov_product_boundary_inside_aux:
  assumes "y  Gromov_boundary"
  shows "extended_Gromov_product_at e y (to_Gromov_completion x) = Inf {liminf (λn. ereal(Gromov_product_at e (v n) x)) |v. (λn. to_Gromov_completion (v n))  y}"
using extended_Gromov_product_inside_boundary_aux[OF assms] by (simp add: extended_Gromov_product_at_commute Gromov_product_commute)

lemma extended_Gromov_product_at_topological:
  "extended_Gromov_product_at e x y = Inf {liminf (λn. ereal(Gromov_product_at e (u n) (v n))) |u v. (λn. to_Gromov_completion (u n))  x  (λn. to_Gromov_completion (v n))  y}"
proof (cases x)
  case boundary
  show ?thesis
  proof (cases y)
    case boundary
    then show ?thesis
      unfolding extended_Gromov_product_at_def Gromov_completion_converge_to_boundary[OF x  Gromov_boundary›] Gromov_completion_converge_to_boundary[OF y  Gromov_boundary›]
      by meson
  next
    case (to_Gromov_completion yi)
    have A: "liminf (λn. ereal (Gromov_product_at e (u n) (v n))) = liminf (λn. ereal (Gromov_product_at e (u n) yi))" if "v  yi" for u v
    proof -
      define h where "h = (λn. Gromov_product_at e (u n) (v n) - Gromov_product_at e (u n) yi)"
      have h: "h  0"
        apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "λn. 0" _ _ "λn. dist (v n) yi"])
        unfolding h_def using Gromov_product_at_diff3[of e _ _ yi] that apply auto
        using tendsto_dist_iff by blast
      have *: "ereal (Gromov_product_at e (u n) (v n)) = h n + ereal (Gromov_product_at e (u n) yi)" for n
        unfolding h_def by auto
      have "liminf (λn. ereal (Gromov_product_at e (u n) (v n))) = 0 + liminf (λn. ereal (Gromov_product_at e (u n) yi))"
        unfolding * apply (rule ereal_liminf_lim_add) using h by (auto simp add: zero_ereal_def)
      then show ?thesis by simp
    qed
    show ?thesis
      unfolding to_Gromov_completion extended_Gromov_product_boundary_inside_aux[OF x  Gromov_boundary›] apply (rule cong[of Inf Inf], auto)
      using A by fast+
  qed
next
  case (to_Gromov_completion xi)
  show ?thesis
  proof (cases y)
    case boundary
    have A: "liminf (λn. ereal (Gromov_product_at e (u n) (v n))) = liminf (λn. ereal (Gromov_product_at e xi (v n)))" if "u  xi" for u v
    proof -
      define h where "h = (λn. Gromov_product_at e (u n) (v n) - Gromov_product_at e xi (v n))"
      have h: "h  0"
        apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "λn. 0" _ _ "λn. dist (u n) xi"])
        unfolding h_def using Gromov_product_at_diff2[of e _ _ xi] that apply auto
        using tendsto_dist_iff by blast
      have *: "ereal (Gromov_product_at e (u n) (v n)) = h n + ereal (Gromov_product_at e xi (v n))" for n
        unfolding h_def by auto
      have "liminf (λn. ereal (Gromov_product_at e (u n) (v n))) = 0 + liminf (λn. ereal (Gromov_product_at e xi (v n)))"
        unfolding * apply (rule ereal_liminf_lim_add) using h by (auto simp add: zero_ereal_def)
      then show ?thesis by simp
    qed
    show ?thesis
      unfolding to_Gromov_completion extended_Gromov_product_inside_boundary_aux[OF y  Gromov_boundary›] apply (rule cong[of Inf Inf], auto)
      using A by fast+
  next
    case (to_Gromov_completion yi)
    have B: "liminf (λn. Gromov_product_at e (u n) (v n)) = Gromov_product_at e xi yi" if "u  xi" "v  yi" for u v
    proof -
      have "(λn. Gromov_product_at e (u n) (v n))  Gromov_product_at e xi yi"
        apply (rule Gromov_product_at_continuous) using that by auto
      then show "liminf (λn. Gromov_product_at e (u n) (v n)) = Gromov_product_at e xi yi"
        by (simp add: lim_imp_Liminf)
    qed
    have *: "{liminf (λn. ereal (Gromov_product_at e (u n) (v n))) |u v. u  xi  v  yi} = {ereal (Gromov_product_at e xi yi)}"
      using B apply auto by (rule exI[of _ "λn. xi"], rule exI[of _ "λn. yi"], auto)
    show ?thesis
      unfolding x = to_Gromov_completion xi y = to_Gromov_completion yi by (auto simp add: *)
  qed
qed

lemma extended_Gromov_product_inside_boundary:
  "extended_Gromov_product_at e (to_Gromov_completion x) y = Inf {liminf (λn. ereal(Gromov_product_at e x (v n))) |v. (λn. to_Gromov_completion (v n))  y}"
proof -
  have A: "liminf (λn. ereal (Gromov_product_at e (u n) (v n))) = liminf (λn. ereal (Gromov_product_at e x (v n)))" if "u  x" for u v
  proof -
    define h where "h = (λn. Gromov_product_at e (u n) (v n) - Gromov_product_at e x (v n))"
    have h: "h  0"
      apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "λn. 0" _ _ "λn. dist (u n) x"])
      unfolding h_def using Gromov_product_at_diff2[of e _ _ x] that apply auto
      using tendsto_dist_iff by blast
    have *: "ereal (Gromov_product_at e (u n) (v n)) = h n + ereal (Gromov_product_at e x (v n))" for n
      unfolding h_def by auto
    have "liminf (λn. ereal (Gromov_product_at e (u n) (v n))) = 0 + liminf (λn. ereal (Gromov_product_at e x (v n)))"
      unfolding * apply (rule ereal_liminf_lim_add) using h by (auto simp add: zero_ereal_def)
    then show ?thesis by simp
  qed
  show ?thesis
    unfolding extended_Gromov_product_at_topological apply (rule cong[of Inf Inf], auto)
    using A by fast+
qed

lemma extended_Gromov_product_boundary_inside:
  "extended_Gromov_product_at e y (to_Gromov_completion x) = Inf {liminf (λn. ereal(Gromov_product_at e (v n) x)) |v. (λn. to_Gromov_completion (v n))  y}"
using extended_Gromov_product_inside_boundary by (simp add: extended_Gromov_product_at_commute Gromov_product_commute)

text ‹Now, we compare the extended Gromov product to a sequence of Gromov products for converging
sequences. As the extended Gromov product is defined as an Inf of limings, it is clearly smaller
than the liminf. More interestingly, it is also of the order of magnitude of the limsup, for
whatever sequence one uses. In other words, it is canonically defined, up to $2 \delta$.›

lemma extended_Gromov_product_le_liminf:
  assumes "(λn. to_Gromov_completion (u n))  xi"
          "(λn. to_Gromov_completion (v n))  eta"
  shows "liminf (λn. Gromov_product_at e (u n) (v n))  extended_Gromov_product_at e xi eta"
unfolding extended_Gromov_product_at_topological using assms by (auto intro!: Inf_lower)

lemma limsup_le_extended_Gromov_product_inside:
  assumes "(λn. to_Gromov_completion (v n))  (eta::('a::Gromov_hyperbolic_space) Gromov_completion)"
  shows "limsup (λn. Gromov_product_at e x (v n))  extended_Gromov_product_at e (to_Gromov_completion x) eta + deltaG(TYPE('a))"
proof (cases eta)
  case boundary
  have A: "limsup (λn. Gromov_product_at e x (v n))  liminf (λn. Gromov_product_at e x (v' n)) + deltaG(TYPE('a))"
    if H: "(λn. to_Gromov_completion (v' n))  eta" for v'
  proof -
    have "ereal a  liminf (λn. Gromov_product_at e x (v' n)) + deltaG(TYPE('a))" if L: "ereal a < limsup (λn. Gromov_product_at e x (v n))" for a
    proof -
      obtain Nv where Nv: "m n. m  Nv  n  Nv  Gromov_product_at e (v m) (v' n)  a"
        using same_limit_imp_Gromov_product_tendsto_infinity[OF eta  Gromov_boundary› assms H] by blast
      obtain N where N: "ereal a < Gromov_product_at e x (v N)" "N  Nv"
        using limsup_obtain[OF L] by blast
      have *: "a - deltaG(TYPE('a))  Gromov_product_at e x (v' n)" if "n  Nv" for n
      proof -
        have "a  min (Gromov_product_at e x (v N)) (Gromov_product_at e (v N) (v' n))"
          apply auto using N(1) Nv[OF N  Nv n  Nv] by auto
        also have "...  Gromov_product_at e x (v' n) + deltaG(TYPE('a))"
          by (intro mono_intros)
        finally show ?thesis by auto
      qed
      have "a - deltaG(TYPE('a))  liminf (λn. Gromov_product_at e x (v' n))"
        apply (rule Liminf_bounded) unfolding eventually_sequentially using * by fastforce
      then show ?thesis
        unfolding ereal_minus(1)[symmetric] by (subst ereal_minus_le[symmetric], auto)
    qed
    then show ?thesis
      using ereal_dense2 not_less by blast
  qed
  have "limsup (λn. Gromov_product_at e x (v n)) - deltaG(TYPE('a))  extended_Gromov_product_at e (to_Gromov_completion x) eta"
    unfolding extended_Gromov_product_inside_boundary by (rule Inf_greatest, auto simp add: A)
  then show ?thesis by auto
next
  case (to_Gromov_completion y)
  then have "v  y" using assms by auto
  have L: "(λn. Gromov_product_at e x (v n))  ereal(Gromov_product_at e x y)"
    using Gromov_product_at_continuous[OF _ _ v  y, of "λn. e" e "λn. x" x] by auto
  show ?thesis
    unfolding to_Gromov_completion using lim_imp_Limsup[OF _ L] by auto
qed

lemma limsup_le_extended_Gromov_product_inside':
  assumes "(λn. to_Gromov_completion (v n))  (eta::('a::Gromov_hyperbolic_space) Gromov_completion)"
  shows "limsup (λn. Gromov_product_at e (v n) x)  extended_Gromov_product_at e eta (to_Gromov_completion x) + deltaG(TYPE('a))"
using limsup_le_extended_Gromov_product_inside[OF assms] by (simp add: Gromov_product_commute extended_Gromov_product_at_commute)

lemma limsup_le_extended_Gromov_product:
  assumes "(λn. to_Gromov_completion (u n))  (xi::('a::Gromov_hyperbolic_space) Gromov_completion)"
          "(λn. to_Gromov_completion (v n))  eta"
  shows "limsup (λn. Gromov_product_at e (u n) (v n))  extended_Gromov_product_at e xi eta + 2 * deltaG(TYPE('a))"
proof -
  consider "xi  Gromov_boundary  eta  Gromov_boundary" | "xi  Gromov_boundary" | "eta  Gromov_boundary"
    by blast
  then show ?thesis
  proof (cases)
    case 1
    then have B: "xi  Gromov_boundary" "eta  Gromov_boundary" by auto
    have A: "limsup (λn. Gromov_product_at e (u n) (v n))  liminf (λn. Gromov_product_at e (u' n) (v' n)) + 2 * deltaG(TYPE('a))"
      if H: "(λn. to_Gromov_completion (u' n))  xi" "(λn. to_Gromov_completion (v' n))  eta" for u' v'
    proof -
      have "ereal a  liminf (λn. Gromov_product_at e (u' n) (v' n)) + 2 * deltaG(TYPE('a))" if L: "ereal a < limsup (λn. Gromov_product_at e (u n) (v n))" for a
      proof -
        obtain Nu where Nu: "m n. m  Nu  n  Nu  Gromov_product_at e (u' m) (u n)  a"
          using same_limit_imp_Gromov_product_tendsto_infinity[OF xi  Gromov_boundary› H(1) assms(1)] by blast
        obtain Nv where Nv: "m n. m  Nv  n  Nv  Gromov_product_at e (v m) (v' n)  a"
          using same_limit_imp_Gromov_product_tendsto_infinity[OF eta  Gromov_boundary› assms(2) H(2)] by blast
        obtain N where N: "ereal a < Gromov_product_at e (u N) (v N)" "N  max Nu Nv"
          using limsup_obtain[OF L] by blast
        then have "N  Nu" "N  Nv" by auto
        have *: "a - 2 * deltaG(TYPE('a))  Gromov_product_at e (u' n) (v' n)" if "n  max Nu Nv" for n
        proof -
          have n: "n  Nu" "n  Nv" using that by auto
          have "a  Min {Gromov_product_at e (u' n) (u N), Gromov_product_at e (u N) (v N), Gromov_product_at e (v N) (v' n)}"
            apply auto using N(1) Nu[OF n(1) N  Nu] Nv[OF N  Nv n(2)] by auto
          also have "...  Gromov_product_at e (u' n) (v' n) + 2 * deltaG(TYPE('a))"
            by (intro mono_intros)
          finally show ?thesis by auto
        qed
        have "a - 2 * deltaG(TYPE('a))  liminf (λn. Gromov_product_at e (u' n) (v' n))"
          apply (rule Liminf_bounded) unfolding eventually_sequentially using * by fastforce
        then show ?thesis
          unfolding ereal_minus(1)[symmetric] by (subst ereal_minus_le[symmetric], auto)
      qed
      then show ?thesis
        using ereal_dense2 not_less by blast
    qed
    have "limsup (λn. Gromov_product_at e (u n) (v n)) - 2 * deltaG(TYPE('a))  extended_Gromov_product_at e xi eta"
      unfolding extended_Gromov_product_at_topological by (rule Inf_greatest, auto simp add: A)
    then show ?thesis by auto
  next
    case 2
    then obtain x where x: "xi = to_Gromov_completion x" by (cases xi, auto)
    have A: "limsup (λn. ereal (Gromov_product_at e (u n) (v n))) = limsup (λn. ereal (Gromov_product_at e x (v n)))"
    proof -
      define h where "h = (λn. Gromov_product_at e (u n) (v n) - Gromov_product_at e x (v n))"
      have h: "h  0"
        apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "λn. 0" _ _ "λn. dist (u n) x"])
        unfolding h_def using Gromov_product_at_diff2[of e _ _ x] assms(1) unfolding x apply auto
        using tendsto_dist_iff by blast
      have *: "ereal (Gromov_product_at e (u n) (v n)) = h n + ereal (Gromov_product_at e x (v n))" for n
        unfolding h_def by auto
      have "limsup (λn. ereal (Gromov_product_at e (u n) (v n))) = 0 + limsup (λn. ereal (Gromov_product_at e x (v n)))"
        unfolding * apply (rule ereal_limsup_lim_add) using h by (auto simp add: zero_ereal_def)
      then show ?thesis by simp
    qed
    have *: "ereal (deltaG TYPE('a))  ereal (2 * deltaG TYPE('a))"
      by auto
    show ?thesis
      unfolding A x using limsup_le_extended_Gromov_product_inside[OF assms(2), of e x] *
      by (meson add_left_mono order.trans)
  next
    case 3
    then obtain y where y: "eta = to_Gromov_completion y" by (cases eta, auto)
    have A: "limsup (λn. ereal (Gromov_product_at e (u n) (v n))) = limsup (λn. ereal (Gromov_product_at e (u n) y))"
    proof -
      define h where "h = (λn. Gromov_product_at e (u n) (v n) - Gromov_product_at e (u n) y)"
      have h: "h  0"
        apply (rule tendsto_rabs_zero_cancel, rule tendsto_sandwich[of "λn. 0" _ _ "λn. dist (v n) y"])
        unfolding h_def using Gromov_product_at_diff3[of e _ _ y] assms(2) unfolding y apply auto
        using tendsto_dist_iff by blast
      have *: "ereal (Gromov_product_at e (u n) (v n)) = h n + ereal (Gromov_product_at e (u n) y)" for n
        unfolding h_def by auto
      have "limsup (λn. ereal (Gromov_product_at e (u n) (v n))) = 0 + limsup (λn. ereal (Gromov_product_at e (u n) y))"
        unfolding * apply (rule ereal_limsup_lim_add) using h by (auto simp add: zero_ereal_def)
      then show ?thesis by simp
    qed
    have *: "ereal (deltaG TYPE('a))  ereal (2 * deltaG TYPE('a))"
      by auto
    show ?thesis
      unfolding A y using limsup_le_extended_Gromov_product_inside'[OF assms(1), of e y] *
      by (meson add_left_mono order.trans)
  qed
qed

text ‹One can then extend to the boundary the fact that $(y,z)_x + (x,z)_y = d(x,y)$, up to a
constant $\delta$, by taking this identity inside and passing to the limit.›

lemma extended_Gromov_product_add_le:
  "extended_Gromov_product_at x xi (to_Gromov_completion y) + extended_Gromov_product_at y xi (to_Gromov_completion x)  dist x y"
proof -
  obtain u where u: "(λn. to_Gromov_completion (u n))  xi"
    using rep_Gromov_completion_limit by blast
  have "liminf (λn. ereal (Gromov_product_at a b (u n)))  0" for a b
    by (rule Liminf_bounded[OF always_eventually], auto)
  then have *: "liminf (λn. ereal (Gromov_product_at a b (u n)))  -" for a b
    by auto
  have "extended_Gromov_product_at x xi (to_Gromov_completion y) + extended_Gromov_product_at y xi (to_Gromov_completion x)
       liminf (λn. ereal (Gromov_product_at x y (u n))) + liminf (λn. Gromov_product_at y x (u n))"
    apply (intro mono_intros)
    using extended_Gromov_product_le_liminf [OF u, of "λn. y" "to_Gromov_completion y" x]
      extended_Gromov_product_le_liminf [OF u, of "λn. x" "to_Gromov_completion x" y] by (auto simp add: Gromov_product_commute)
  also have "...  liminf (λn. ereal (Gromov_product_at x y (u n)) + Gromov_product_at y x (u n))"
    by (rule ereal_liminf_add_mono, auto simp add: *)
  also have "... = dist x y"
    apply (simp add: Gromov_product_add)
    by (metis lim_imp_Liminf sequentially_bot tendsto_const)
  finally show ?thesis by auto
qed

lemma extended_Gromov_product_add_ge:
  "extended_Gromov_product_at (x::'a::Gromov_hyperbolic_space) xi (to_Gromov_completion y) + extended_Gromov_product_at y xi (to_Gromov_completion x)  dist x y - deltaG(TYPE('a))"
proof -
  have A: "dist x y - extended_Gromov_product_at y (to_Gromov_completion x) xi - deltaG(TYPE('a))  liminf (λn. ereal (Gromov_product_at x y (u n)))"
    if "(λn. to_Gromov_completion (u n))  xi" for u
  proof -
    have "dist x y = liminf (λn. ereal (Gromov_product_at x y (u n)) + Gromov_product_at y x (u n))"
      apply (simp add: Gromov_product_add)
      by (metis lim_imp_Liminf sequentially_bot tendsto_const)
    also have "...  liminf (λn. ereal (Gromov_product_at x y (u n))) + limsup (λn. Gromov_product_at y x (u n))"
      by (rule ereal_liminf_limsup_add)
    also have "...  liminf (λn. ereal (Gromov_product_at x y (u n))) + (extended_Gromov_product_at y (to_Gromov_completion x) xi + deltaG(TYPE('a)))"
      by (intro mono_intros limsup_le_extended_Gromov_product_inside[OF that])
    finally show ?thesis by (auto simp add: algebra_simps)
  qed
  have "dist x y - extended_Gromov_product_at y (to_Gromov_completion x) xi - deltaG(TYPE('a))  extended_Gromov_product_at x (to_Gromov_completion y) xi"
    unfolding extended_Gromov_product_inside_boundary[of x] apply (rule Inf_greatest) using A by auto
  then show ?thesis
    apply (auto simp add: algebra_simps extended_Gromov_product_at_commute)
    unfolding ereal_minus(1)[symmetric] by (subst ereal_minus_le, auto simp add: algebra_simps)
qed

text ‹If one perturbs a sequence inside the space by a bounded distance, one does not change the
limit on the boundary.›

lemma Gromov_converging_at_boundary_bounded_perturbation:
  assumes "(λn. to_Gromov_completion (u n))  x"
          "x  Gromov_boundary"
          "n. dist (u n) (v n)  C"
  shows "(λn. to_Gromov_completion (v n))  x"
proof -
  have "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x)  "
  proof (rule tendsto_sandwich[of "λn. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x - C" _ _ "λn. "])
    show "F n in sequentially. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x - ereal C  extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x"
    proof (rule always_eventually, auto)
      fix n::nat
      have "extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x  extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x
                  + extended_Gromov_distance (to_Gromov_completion (u n)) (to_Gromov_completion (v n))"
        by (intro mono_intros)
      also have "...  extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x + C"
        using assms(3)[of n] by (intro mono_intros, auto)
      finally show "extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x  extended_Gromov_product_at basepoint (to_Gromov_completion (v n)) x + ereal C"
        by auto
    qed
    have "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x - ereal C)   - ereal C"
      apply (intro tendsto_intros)
      unfolding Gromov_completion_boundary_limit[OF x  Gromov_boundary›, symmetric] using assms(1) by auto
    then show "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (u n)) x - ereal C)  "
      by auto
  qed (auto)
  then show ?thesis
    unfolding Gromov_completion_boundary_limit[OF x  Gromov_boundary›] by simp
qed

text ‹We prove that the extended Gromov distance is a continuous function of one variable,
by separating the different cases at infinity and inside the space. Note that it is not a
continuous function of both variables: if $u_n$ is inside the space but tends to a point $x$ in the
boundary, then the extended Gromov distance between $u_n$ and $u_n$ is $0$, but for the limit it is
$\infty$.›

lemma extended_Gromov_distance_continuous:
  "continuous_on UNIV (λy. extended_Gromov_distance x y)"
proof (cases x)
  text ‹First, if $x$ is in the boundary, then all distances to $x$ are infinite, and the statement
  is trivial.›
  case boundary
  then have *: "extended_Gromov_distance x y = " for y
    by auto
  show ?thesis
    unfolding * using continuous_on_topological by blast
next
  text ‹Next, consider the case where $x$ is inside the space. We split according to whether $y$ is
  inside the space or at infinity.›
  case (to_Gromov_completion a)
  have "(λn. extended_Gromov_distance x (u n))  extended_Gromov_distance x y" if "u  y" for u y
  proof (cases y)
    text ‹If $y$ is at infinity, then we know that the Gromov product of $u_n$ and $y$ tends to
    infinity. Therefore, the extended distance from $u_n$ to any fixed point also tends to infinity
    (as the Gromov product is bounded from below by the extended distance).›
    case boundary
    have *: "(λn. extended_Gromov_product_at a (u n) y)  "
      by (rule extended_Gromov_product_tendsto_PInf_a_b[OF iffD1[OF Gromov_completion_boundary_limit, OF boundary u  y]])
    have "(λn. extended_Gromov_distance x (u n))  "
      apply (rule tendsto_sandwich[of "λn. extended_Gromov_product_at a (u n) y" _ _ "λ_. "])
      unfolding to_Gromov_completion using extended_Gromov_product_le_dist[of a "u _" y] * by auto
    then show ?thesis using boundary by auto
  next
    text ‹If $y$ is inside the space, then we use the triangular inequality for the extended Gromov
    distance to conclure.›
    case (to_Gromov_completion b)
    then have F: "y  Gromov_boundary" by auto
    have *: "(λn. extended_Gromov_distance (u n) y)  0"
      by (rule iffD1[OF Gromov_completion_inside_limit[OF F] u  y])
    show "(λn. extended_Gromov_distance x (u n))  extended_Gromov_distance x y"
    proof (rule tendsto_sandwich[of "λn. extended_Gromov_distance x y - extended_Gromov_distance (u n) y" _ _
                                    "λn. extended_Gromov_distance x y + extended_Gromov_distance (u n) y"])
      have "extended_Gromov_distance x y - extended_Gromov_distance (u n) y  extended_Gromov_distance x (u n)" for n
        using extended_Gromov_distance_triangle[of y x "u n"]
        by (auto simp add: extended_Gromov_distance_commute F ennreal_minus_le_iff extended_Gromov_distance_def)
      then show "F n in sequentially. extended_Gromov_distance x y - extended_Gromov_distance (u n) y  extended_Gromov_distance x (u n)"
        by auto
      have "extended_Gromov_distance x (u n)  extended_Gromov_distance x y + extended_Gromov_distance (u n) y" for n
        using extended_Gromov_distance_triangle[of x "u n" y] by (auto simp add: extended_Gromov_distance_commute)
      then show "F n in sequentially. extended_Gromov_distance x (u n)  extended_Gromov_distance x y + extended_Gromov_distance (u n) y"
        by auto
      have "(λn. extended_Gromov_distance x y - extended_Gromov_distance (u n) y)  extended_Gromov_distance x y - 0"
        by (intro tendsto_intros *, auto)
      then show "(λn. extended_Gromov_distance x y - extended_Gromov_distance (u n) y)  extended_Gromov_distance x y"
        by simp
      have "(λn. extended_Gromov_distance x y + extended_Gromov_distance (u n) y)  extended_Gromov_distance x y + 0"
        by (intro tendsto_intros *, auto)
      then show "(λn. extended_Gromov_distance x y + extended_Gromov_distance (u n) y)  extended_Gromov_distance x y"
        by simp
    qed
  qed
  then show ?thesis
    unfolding continuous_on_sequentially comp_def by auto
qed

lemma extended_Gromov_distance_continuous':
  "continuous_on UNIV (λx. extended_Gromov_distance x y)"
using extended_Gromov_distance_continuous[of y] extended_Gromov_distance_commute[of _ y] by auto


subsection ‹Topology of the Gromov boundary›

text ‹We deduce the basic fact that the original space is open in the Gromov completion from the
continuity of the extended distance.›

lemma to_Gromov_completion_range_open:
  "open (range to_Gromov_completion)"
proof -
  have *: "range to_Gromov_completion = (λx. extended_Gromov_distance (to_Gromov_completion basepoint) x)-`{..<}"
    using Gromov_boundary_def extended_Gromov_distance_PInf_boundary(2) by fastforce
  show ?thesis
    unfolding * using extended_Gromov_distance_continuous open_lessThan open_vimage by blast
qed

lemma Gromov_boundary_closed:
  "closed Gromov_boundary"
unfolding Gromov_boundary_def using to_Gromov_completion_range_open by auto

text ‹The original space is also dense in its Gromov completion, as all points at infinity are
by definition limits of some sequence in the space.›

lemma to_Gromov_completion_range_dense [simp]:
  "closure (range to_Gromov_completion) = UNIV"
apply (auto simp add: closure_sequential) using rep_Gromov_completion_limit by force

lemma to_Gromov_completion_homeomorphism:
  "homeomorphism_on UNIV to_Gromov_completion"
by (rule homeomorphism_on_sequentially, auto)

lemma to_Gromov_completion_continuous:
  "continuous_on UNIV to_Gromov_completion"
by (rule homeomorphism_on_continuous[OF to_Gromov_completion_homeomorphism])

lemma from_Gromov_completion_continuous:
  "homeomorphism_on (range to_Gromov_completion) from_Gromov_completion"
  "continuous_on (range to_Gromov_completion) from_Gromov_completion"
  "x::('a::Gromov_hyperbolic_space) Gromov_completion. x  range to_Gromov_completion  continuous (at x) from_Gromov_completion"
proof -
  show *: "homeomorphism_on (range to_Gromov_completion) from_Gromov_completion"
    using homeomorphism_on_inverse[OF to_Gromov_completion_homeomorphism] unfolding from_Gromov_completion_def[symmetric] by simp
  show "continuous_on (range to_Gromov_completion) from_Gromov_completion"
    by (simp add: * homeomorphism_on_continuous)
  then show "continuous (at x) from_Gromov_completion" if "x  range to_Gromov_completion" for x::"'a Gromov_completion"
    using continuous_on_eq_continuous_at that to_Gromov_completion_range_open by auto
qed

text ‹The Gromov boundary is always complete. Indeed, consider a Cauchy sequence $u_n$ in the
boundary, and approximate well enough $u_n$ by a point $v_n$ inside. Then the sequence $v_n$
is Gromov converging at infinity (the respective Gromov products tend to infinity essentially
by definition), and its limit point is the limit of the original sequence $u$.›

proposition Gromov_boundary_complete:
  "complete Gromov_boundary"
proof (rule completeI)
  fix u::"nat  'a Gromov_completion" assume "n. u n  Gromov_boundary" "Cauchy u"
  then have u: "n. u n  Gromov_boundary" by auto
  have *: "x  range to_Gromov_completion. dist (u n) x < 1/real(n+1)" for n
    by (rule closure_approachableD, auto simp add: to_Gromov_completion_range_dense)
  have "v. n. dist (to_Gromov_completion (v n)) (u n) < 1/real(n+1)"
    using of_nat_less_top apply (intro choice) using * by (auto simp add: dist_commute)
  then obtain v where v: "n. dist (to_Gromov_completion (v n)) (u n) < 1/real(n+1)"
    by blast
  have "(λn. dist (to_Gromov_completion (v n)) (u n))  0"
    apply (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. 1/real(n+1)"])
    using v LIMSEQ_ignore_initial_segment[OF lim_1_over_n, of 1] unfolding eventually_sequentially
    by (auto simp add: less_imp_le)

  have "Gromov_converging_at_boundary v"
  proof (rule Gromov_converging_at_boundaryI[of basepoint])
    fix M::real
    obtain D1 e1 where D1: "e1 > 0" "D1 < " "x y::'a Gromov_completion. dist x y  e1  extended_Gromov_distance x (to_Gromov_completion basepoint)  D1  extended_Gromov_product_at basepoint x y  ereal M"
      using large_Gromov_product_approx[of "ereal M"] by auto
    obtain D2 e2 where D2: "e2 > 0" "D2 < " "x y::'a Gromov_completion. dist x y  e2  extended_Gromov_distance x (to_Gromov_completion basepoint)  D2  extended_Gromov_product_at basepoint x y  D1"
      using large_Gromov_product_approx[OF D1 < ] by auto
    define e where "e = (min e1 e2)/3"
    have "e > 0" unfolding e_def using e1 > 0 e2 > 0 by auto
    then obtain N1 where N1: "n m. n  N1  m  N1  dist (u n) (u m) < e"
      using ‹Cauchy u unfolding Cauchy_def by blast
    have "eventually (λn. dist (to_Gromov_completion (v n)) (u n) < e) sequentially"
      by (rule order_tendstoD[OF (λn. dist (to_Gromov_completion (v n)) (u n))  0], fact)
    then obtain N2 where N2: "n. n  N2  dist (to_Gromov_completion (v n)) (u n) < e"
      unfolding eventually_sequentially by auto
    have "ereal M  extended_Gromov_product_at basepoint (to_Gromov_completion (v m)) (to_Gromov_completion (v n))"
      if "n  max N1 N2" "m  max N1 N2" for m n
    proof (rule D1(3))
      have "dist (to_Gromov_completion (v m)) (to_Gromov_completion (v n))
         dist (to_Gromov_completion (v m)) (u m) + dist (u m) (u n) + dist (u n) (to_Gromov_completion (v n))"
        by (intro mono_intros)
      also have "...  e + e + e"
        apply (intro mono_intros)
        using N1[of m n] N2[of n] N2[of m] that by (auto simp add: dist_commute)
      also have "...  e1" unfolding e_def by auto
      finally show "dist (to_Gromov_completion (v m)) (to_Gromov_completion (v n))  e1" by simp

      have "e  e2" unfolding e_def using e2 > 0 by auto
      have "D1  extended_Gromov_product_at basepoint (u m) (to_Gromov_completion (v m))"
        apply (rule D2(3)) using N2[of m] that e  e2 u[of m] by (auto simp add: dist_commute)
      also have "...  extended_Gromov_distance (to_Gromov_completion basepoint) (to_Gromov_completion (v m))"
        using extended_Gromov_product_le_dist[of basepoint "to_Gromov_completion (v m)" "u m"]
        by (simp add: extended_Gromov_product_at_commute)
      finally show "D1  extended_Gromov_distance (to_Gromov_completion (v m)) (to_Gromov_completion basepoint)"
        by (simp add: extended_Gromov_distance_commute)
    qed
    then have "M  Gromov_product_at basepoint (v m) (v n)" if "n  max N1 N2" "m  max N1 N2" for m n
      using that by auto
    then show "N. n  N. m  N. M  Gromov_product_at basepoint (v m) (v n)"
      by blast
  qed
  then obtain l where l: "l  Gromov_boundary" "(λn. to_Gromov_completion (v n))  l"
    using Gromov_converging_at_boundary_converges by blast
  have "(λn. dist (u n) l)  0+0"
  proof (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. dist (u n) (to_Gromov_completion (v n)) + dist (to_Gromov_completion (v n)) l"])
    show "(λn. dist (u n) (to_Gromov_completion (v n)) + dist (to_Gromov_completion (v n)) l)  0 + 0"
      apply (intro tendsto_intros)
      using iffD1[OF tendsto_dist_iff l(2)] (λn. dist (to_Gromov_completion (v n)) (u n))  0
      by (auto simp add: dist_commute)
  qed (auto simp add: dist_triangle)
  then have "u  l"
    using iffD2[OF tendsto_dist_iff] by auto
  then show "lGromov_boundary. u  l"
    using l(1) by auto
qed

text ‹When the initial space is complete, then the whole Gromov completion is also complete:
for Cauchy sequences tending to the Gromov boundary, then the convergence is proved as in the
completeness of the boundary above. For Cauchy sequences that remain bounded, the convergence
is reduced to the convergence inside the original space, which holds by assumption.›

proposition Gromov_completion_complete:
  assumes "complete (UNIV::'a::Gromov_hyperbolic_space set)"
  shows "complete (UNIV::'a Gromov_completion set)"
proof (rule completeI, auto)
  fix u0::"nat  'a Gromov_completion" assume "Cauchy u0"
  show "l. u0  l"
  proof (cases "limsup (λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n)) = ")
    case True
    then obtain r where r: "strict_mono r" "(λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 (r n)))  "
      using limsup_subseq_lim[of "(λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n))"] unfolding comp_def
      by auto
    define u where "u = u0 o r"
    then have "(λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u n))  "
      unfolding comp_def using r(2) by simp
    have "Cauchy u"
      using ‹Cauchy u0 r(1) u_def by (simp add: Cauchy_subseq_Cauchy)

    have *: "x  range to_Gromov_completion. dist (u n) x < 1/real(n+1)" for n
      by (rule closure_approachableD, auto)
    have "v. n. dist (to_Gromov_completion (v n)) (u n) < 1/real(n+1)"
      using of_nat_less_top apply (intro choice) using * by (auto simp add: dist_commute)
    then obtain v where v: "n. dist (to_Gromov_completion (v n)) (u n) < 1/real(n+1)"
      by blast
    have "(λn. dist (to_Gromov_completion (v n)) (u n))  0"
      apply (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. 1/real(n+1)"])
      using v LIMSEQ_ignore_initial_segment[OF lim_1_over_n, of 1] unfolding eventually_sequentially
      by (auto simp add: less_imp_le)

    have "Gromov_converging_at_boundary v"
    proof (rule Gromov_converging_at_boundaryI[of basepoint])
      fix M::real
      obtain D1 e1 where D1: "e1 > 0" "D1 < " "x y::'a Gromov_completion. dist x y  e1  extended_Gromov_distance x (to_Gromov_completion basepoint)  D1  extended_Gromov_product_at basepoint x y  ereal M"
        using large_Gromov_product_approx[of "ereal M"] by auto
      obtain D2 e2 where D2: "e2 > 0" "D2 < " "x y::'a Gromov_completion. dist x y  e2  extended_Gromov_distance x (to_Gromov_completion basepoint)  D2  extended_Gromov_product_at basepoint x y  D1"
        using large_Gromov_product_approx[OF D1 < ] by auto
      define e where "e = (min e1 e2)/3"
      have "e > 0" unfolding e_def using e1 > 0 e2 > 0 by auto
      then obtain N1 where N1: "n m. n  N1  m  N1  dist (u n) (u m) < e"
        using ‹Cauchy u unfolding Cauchy_def by blast
      have "eventually (λn. dist (to_Gromov_completion (v n)) (u n) < e) sequentially"
        by (rule order_tendstoD[OF (λn. dist (to_Gromov_completion (v n)) (u n))  0], fact)
      then obtain N2 where N2: "n. n  N2  dist (to_Gromov_completion (v n)) (u n) < e"
        unfolding eventually_sequentially by auto
      have "eventually (λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u n) > D2) sequentially"
        by (rule order_tendstoD[OF (λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u n))  ], fact)
      then obtain N3 where N3: "n. n  N3  extended_Gromov_distance (to_Gromov_completion basepoint) (u n) > D2"
        unfolding eventually_sequentially by auto
      define N where "N = N1+N2+N3"
      have N: "N  N1" "N  N2" "N  N3" unfolding N_def by auto
      have "ereal M  extended_Gromov_product_at basepoint (to_Gromov_completion (v m)) (to_Gromov_completion (v n))"
        if "n  N" "m  N" for m n
      proof (rule D1(3))
        have "dist (to_Gromov_completion (v m)) (to_Gromov_completion (v n))
           dist (to_Gromov_completion (v m)) (u m) + dist (u m) (u n) + dist (u n) (to_Gromov_completion (v n))"
          by (intro mono_intros)
        also have "...  e + e + e"
          apply (intro mono_intros)
          using N1[of m n] N2[of n] N2[of m] that N by (auto simp add: dist_commute)
        also have "...  e1" unfolding e_def by auto
        finally show "dist (to_Gromov_completion (v m)) (to_Gromov_completion (v n))  e1" by simp

        have "e  e2" unfolding e_def using e2 > 0 by auto
        have "D1  extended_Gromov_product_at basepoint (u m) (to_Gromov_completion (v m))"
          apply (rule D2(3)) using N2[of m] N3[of m] that N e  e2
          by (auto simp add: dist_commute extended_Gromov_distance_commute)
        also have "...  extended_Gromov_distance (to_Gromov_completion basepoint) (to_Gromov_completion (v m))"
          using extended_Gromov_product_le_dist[of basepoint "to_Gromov_completion (v m)" "u m"]
          by (simp add: extended_Gromov_product_at_commute)
        finally show "D1  extended_Gromov_distance (to_Gromov_completion (v m)) (to_Gromov_completion basepoint)"
          by (simp add: extended_Gromov_distance_commute)
      qed
      then have "M  Gromov_product_at basepoint (v m) (v n)" if "n  N" "m  N" for m n
        using that by auto
      then show "N. n  N. m  N. M  Gromov_product_at basepoint (v m) (v n)"
        by blast
    qed
    then obtain l where l: "l  Gromov_boundary" "(λn. to_Gromov_completion (v n))  l"
      using Gromov_converging_at_boundary_converges by blast
    have "(λn. dist (u n) l)  0+0"
    proof (rule tendsto_sandwich[of "λ_. 0" _ _ "λn. dist (u n) (to_Gromov_completion (v n)) + dist (to_Gromov_completion (v n)) l"])
      show "(λn. dist (u n) (to_Gromov_completion (v n)) + dist (to_Gromov_completion (v n)) l)  0 + 0"
        apply (intro tendsto_intros)
        using iffD1[OF tendsto_dist_iff l(2)] (λn. dist (to_Gromov_completion (v n)) (u n))  0
        by (auto simp add: dist_commute)
    qed (auto simp add: dist_triangle)
    then have "u  l"
      using iffD2[OF tendsto_dist_iff] by auto
    then have "u0  l"
      unfolding u_def using r(1) ‹Cauchy u0 Cauchy_converges_subseq by auto
    then show "l. u0  l"
      by auto
  next
    case False
    define C where "C = limsup (λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n)) + 1"
    have "C < " unfolding C_def using False less_top by fastforce
    have *: "limsup (λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n))  0"
      by (intro le_Limsup always_eventually, auto)
    have "limsup (λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n)) < C"
      unfolding C_def using False * ereal_add_left_cancel_less by force
    then have "eventually (λn. extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n) < C) sequentially"
      using Limsup_lessD by blast
    then obtain N where N: "n. n  N  extended_Gromov_distance (to_Gromov_completion basepoint) (u0 n) < C"
      unfolding eventually_sequentially by auto
    define r where "r = (λn. n + N)"
    have r: "strict_mono r" unfolding r_def strict_mono_def by auto
    define u where "u = (u0 o r)"
    have "Cauchy u"
      using ‹Cauchy u0 r(1) u_def by (simp add: Cauchy_subseq_Cauchy)
    have u: "extended_Gromov_distance (to_Gromov_completion basepoint) (u n)  C" for n
      unfolding u_def comp_def r_def using N by (auto simp add: less_imp_le)
    define v where "v = (λn. from_Gromov_completion (u n))"
    have uv: "u n = to_Gromov_completion (v n)" for n
      unfolding v_def apply (rule to_from_Gromov_completion[symmetric]) using u[of n] C <  by auto
    have "Cauchy v"
    proof (rule metric_CauchyI)
      obtain a::real where a: "a > 0" "x y::'a Gromov_completion. extended_Gromov_distance (to_Gromov_completion basepoint) x  C  dist x y  a
           esqrt(extended_Gromov_distance x y)  2 * ereal(dist x y)"
        using inside_Gromov_distance_approx[OF C < ] by auto
      fix e::real assume "e > 0"
      define e2 where "e2 = min (sqrt (e/2) /2) a"
      have "e2 > 0" unfolding e2_def using e > 0 a > 0 by auto
      then obtain N where N: "m n. m  N  n  N  dist (u m) (u n) < e2"
        using ‹Cauchy u unfolding Cauchy_def by blast
      have "dist (v m) (v n) < e" if "n  N" "m  N" for m n
      proof -
        have "ereal(sqrt(dist (v m) (v n))) = esqrt(extended_Gromov_distance (u m) (u n))"
          unfolding uv by (auto simp add: esqrt_ereal_ereal_sqrt)
        also have "...  2 * ereal(dist (u m) (u n))"
          apply (rule a(2)) using u[of m] N[OF m  N n  N] unfolding e2_def by auto
        also have "... = ereal(2 * dist (u m) (u n))"
          by simp
        also have "...  ereal(2 * e2)"
          apply (intro mono_intros) using N[OF m  N n  N] less_imp_le by auto
        finally have "sqrt(dist (v m) (v n))  2 * e2"
          using e2 > 0 by auto
        also have "...  sqrt (e/2)"
          unfolding e2_def by auto
        finally have "dist (v m) (v n)  e/2"
          by auto
        then show ?thesis
          using e > 0 by auto
      qed
      then show "M. m  M. n  M. dist (v m) (v n) < e" by auto
    qed
    then obtain l where "v  l"
      using ‹complete (UNIV::'a set) complete_def by blast
    then have "u  (to_Gromov_completion l)"
      unfolding uv by auto
    then have "u0  (to_Gromov_completion l)"
      unfolding u_def using r(1) ‹Cauchy u0 Cauchy_converges_subseq by auto
    then show "l. u0  l"
      by auto
  qed
qed

instance Gromov_completion::("{Gromov_hyperbolic_space, complete_space}") complete_space
  apply standard
  using Gromov_completion_complete complete_def convergent_def complete_UNIV by auto

text ‹When the original space is proper, i.e., closed balls are compact, and geodesic, then the
Gromov completion (and therefore the Gromov boundary) are compact. The idea to extract a convergent
subsequence of a sequence $u_n$ in the boundary is to take the point $v_n$ at distance $T$ along
a geodesic tending to the point $u_n$ on the boundary, where $T$ is fixed and large. The points
$v_n$ live in a bounded subset of the space, hence they have a convergent subsequence $v_{j(n)}$.
It follows that $u_{j(n)}$ is almost converging, up to an error that tends to $0$ when $T$ tends
to infinity. By a diagonal argument, we obtain a convergent subsequence of $u_n$.

As we have already proved that the space is complete, there is a shortcut to the above argument,
avoiding subsequences and diagonal argument altogether. Indeed, in a complete space it suffices
to show that for any $\epsilon > 0$ it is covered by finitely many balls of radius $\epsilon$ to get
the compactness. This is what we do in the following proof, although the argument is precisely
modelled on the first proof we have explained.›

theorem Gromov_completion_compact:
  assumes "proper (UNIV::'a::Gromov_hyperbolic_space_geodesic set)"
  shows "compact (UNIV::'a Gromov_completion set)"
proof -
  have "k. finite k  (UNIV::'a Gromov_completion set)  (xk. ball x e)" if "e > 0" for e
  proof -
    define D::real where "D = max 0 (-ln(e/4)/epsilonG(TYPE('a)))"
    have "D  0" unfolding D_def by auto
    have "exp(-epsilonG(TYPE('a)) * D)  exp(ln (e / 4))"
      unfolding D_def apply (intro mono_intros) unfolding max_def
      apply auto
      using constant_in_extended_predist_pos(1)[where ?'a = 'a] by (auto simp add: divide_simps)
    then have "exp(-epsilonG(TYPE('a)) * D)  e/4" using e > 0 by auto
    define e0::real where "e0 = e * e / 16"
    have "e0 > 0" using e > 0 unfolding e0_def by auto
    obtain k::"'a set" where k: "finite k" "cball basepoint D  (xk. ball x e0)"
      using compact_eq_totally_bounded[of "cball (basepoint::'a) D"] assms e0 > 0
      unfolding proper_def by auto
    have A: "y  k. dist (to_Gromov_completion y) (to_Gromov_completion x)  e/4" if "dist basepoint x  D" for x::'a
    proof -
      obtain z where z: "z  k" "dist z x < e0" using ‹dist basepoint x  D k(2) by auto
      have "ereal(dist (to_Gromov_completion z) (to_Gromov_completion x))  esqrt(extended_Gromov_distance (to_Gromov_completion z) (to_Gromov_completion x))"
        by (intro mono_intros)
      also have "... = ereal(sqrt (dist z x))"
        by auto
      finally have "dist (to_Gromov_completion z) (to_Gromov_completion x)  sqrt (dist z x)"
        by auto
      also have "...  sqrt e0"
        using z(2) by auto
      also have "...  e/4"
        unfolding e0_def using e > 0 by (auto simp add: less_imp_le real_sqrt_divide)
      finally have "dist (to_Gromov_completion z) (to_Gromov_completion x)  e/4"
        by auto
      then show ?thesis
        using z  k by auto
    qed
    have B: "y  k. dist (to_Gromov_completion y) (to_Gromov_completion x)  e/2" for x
    proof (cases "dist basepoint x  D")
      case True
      have "e/4  e/2" using e > 0 by auto
      then show ?thesis using A[OF True] by force
    next
      case False
      define x2 where "x2 = geodesic_segment_param {basepoint--x} basepoint D"
      have *: "Gromov_product_at basepoint x x2 = D"
        unfolding x2_def apply (rule Gromov_product_geodesic_segment) using False D  0 by auto
      have "ereal(dist (to_Gromov_completion x) (to_Gromov_completion x2))
             eexp (- epsilonG(TYPE('a)) * extended_Gromov_product_at basepoint (to_Gromov_completion x) (to_Gromov_completion x2))"
        by (intro mono_intros)
      also have "... = eexp (- epsilonG(TYPE('a)) * ereal D)"
        using * by auto
      also have "... = ereal(exp(-epsilonG(TYPE('a)) * D))"
        by auto
      also have "...  ereal(e/4)"
        by (intro mono_intros, fact)
      finally have "dist (to_Gromov_completion x) (to_Gromov_completion x2)  e/4"
        using e > 0 by auto
      have "dist basepoint x2  D"
        unfolding x2_def using False 0  D by auto
      then obtain y where "y  k" "dist (to_Gromov_completion y) (to_Gromov_completion x2)  e/4"
        using A by auto
      have "dist (to_Gromov_completion y) (to_Gromov_completion x)
             dist (to_Gromov_completion y) (to_Gromov_completion x2) + dist (to_Gromov_completion x) (to_Gromov_completion x2)"
        by (intro mono_intros)
      also have "...  e/4 + e/4"
        by (intro mono_intros, fact, fact)
      also have "... = e/2" by simp
      finally show ?thesis using y  k by auto
    qed
    have C: "y  k. dist (to_Gromov_completion y) x < e" for x
    proof -
      obtain x1 where x1: "dist x x1 < e/2" "x1  range to_Gromov_completion"
        using to_Gromov_completion_range_dense e > 0
        by (metis (no_types, hide_lams) UNIV_I closure_approachableD divide_pos_pos zero_less_numeral)
      then obtain z where z: "x1 = to_Gromov_completion z" by auto
      then obtain y where y: "y  k" "dist (to_Gromov_completion y) (to_Gromov_completion z)  e/2"
        using B by auto
      have "dist (to_Gromov_completion y) x 
              dist (to_Gromov_completion y) (to_Gromov_completion z) + dist x x1"
        unfolding z by (intro mono_intros)
      also have "... < e/2 + e/2"
        using x1(1) y(2) by auto
      also have "... = e"
        by auto
      finally show ?thesis using y  k by auto
    qed
    show ?thesis
      apply (rule exI[of _ "to_Gromov_completion`k"])
      using C ‹finite k by auto
  qed
  then show ?thesis
    unfolding compact_eq_totally_bounded
    using Gromov_completion_complete[OF complete_of_proper[OF assms]] by auto
qed

text ‹If the inner space is second countable, so is its completion, as the former is dense in the
latter.›

instance Gromov_completion::("{Gromov_hyperbolic_space, second_countable_topology}") second_countable_topology
proof
  obtain A::"'a set" where "countable A" "closure A = UNIV"
    using second_countable_metric_dense_subset by auto
  define Ab where "Ab = to_Gromov_completion`A"
  have "range to_Gromov_completion  closure Ab"
    unfolding Ab_def
    by (metis ‹closure A = UNIV› closed_closure closure_subset image_closure_subset to_Gromov_completion_continuous)
  then have "closure Ab = UNIV"
    by (metis closed_closure closure_minimal dual_order.antisym to_Gromov_completion_range_dense top_greatest)
  moreover have "countable Ab" unfolding Ab_def using ‹countable A by auto
  ultimately have "Ab::'a Gromov_completion set. countable Ab  closure Ab = UNIV"
    by auto
  then show "B::'a Gromov_completion set set. countable B  open = generate_topology B"
    using second_countable_iff_dense_countable_subset topological_basis_imp_subbasis by auto
qed

text ‹The same follows readily for the Polish space property.›

instance metric_completion::("{Gromov_hyperbolic_space, polish_space}") polish_space
by standard


subsection ‹The Gromov completion of the real line.›

text ‹We show in the paragraph that the Gromov completion of the real line is obtained by adding
one point at $+\infty$ and one point at $-\infty$. In other words, it coincides with ereal.

To show this, we have to understand which sequences of reals are Gromov-converging to the
boundary. We show in the next lemma that they are exactly the sequences that converge to $-\infty$
or to $+\infty$.›

lemma real_Gromov_converging_to_boundary:
  fixes u::"nat  real"
  shows "Gromov_converging_at_boundary u  ((u  )  (u  - ))"
proof -
  have *: "Gromov_product_at 0 m n  min m n" for m n::real
    unfolding Gromov_product_at_def dist_real_def by auto
  have A: "Gromov_converging_at_boundary u" if "u  " for u::"nat  real"
  proof (rule Gromov_converging_at_boundaryI[of 0])
    fix M::real
    have "eventually (λn. ereal (u n) > M) sequentially"
      by (rule order_tendstoD(1)[OF u  , of "ereal M"], auto)
    then obtain N where "n. n  N  ereal (u n) > M"
      unfolding eventually_sequentially by auto
    then have A: "u n  M" if "n  N" for n
      by (simp add: less_imp_le that)
    have "M  Gromov_product_at 0 (u m) (u n)" if "n  N" "m  N" for m n
      using A[OF m  N] A[OF n  N] *[of "u m" "u n"] by auto
    then show "N. n  N. m  N. M  Gromov_product_at 0 (u m) (u n)"
      by auto
  qed
  have *: "Gromov_product_at 0 m n  - max m n" for m n::real
    unfolding Gromov_product_at_def dist_real_def by auto
  have B: "Gromov_converging_at_boundary u" if "u  -" for u::"nat  real"
  proof (rule Gromov_converging_at_boundaryI[of 0])
    fix M::real
    have "eventually (λn. ereal (u n) < - M) sequentially"
      by (rule order_tendstoD(2)[OF u  -, of "ereal (-M)"], auto)
    then obtain N where "n. n  N  ereal (u n) < - M"
      unfolding eventually_sequentially by auto
    then have A: "u n  - M" if "n  N" for n
      by (simp add: less_imp_le that)
    have "M  Gromov_product_at 0 (u m) (u n)" if "n  N" "m  N" for m n
      using A[OF m  N] A[OF n  N] *[of "u m" "u n"] by auto
    then show "N. n  N. m  N. M  Gromov_product_at 0 (u m) (u n)"
      by auto
  qed
  have L: "(u  )  (u  - )" if "Gromov_converging_at_boundary u" for u::"nat  real"
  proof -
    have "(λn. abs(u n))  "
      using Gromov_converging_at_boundary_imp_unbounded[OF that, of 0] unfolding dist_real_def by auto

    obtain r where r: "strict_mono r" "(λn. ereal (u (r n)))  liminf (λn. ereal(u n))"
      using liminf_subseq_lim[of "λn. ereal(u n)"] unfolding comp_def by auto
    have "(λn. abs(ereal (u (r n))))  abs(liminf (λn. ereal(u n)))"
      apply (intro tendsto_intros) using r(2) by auto
    moreover have "(λn. abs(ereal (u (r n))))  "
      using (λn. abs(u n))   apply auto
      using filterlim_compose filterlim_subseq[OF r(1)] by blast
    ultimately have A: "abs(liminf (λn. ereal(u n))) = "
      using LIMSEQ_unique by auto

    obtain r where r: "strict_mono r" "(λn. ereal (u (r n)))  limsup (λn. ereal(u n))"
      using limsup_subseq_lim[of "λn. ereal(u n)"] unfolding comp_def by auto
    have "(λn. abs(ereal (u (r n))))  abs(limsup (λn. ereal(u n)))"
      apply (intro tendsto_intros) using r(2) by auto
    moreover have "(λn. abs(ereal (u (r n))))  "
      using (λn. abs(u n))   apply auto
      using filterlim_compose filterlim_subseq[OF r(1)] by blast
    ultimately have B: "abs(limsup (λn. ereal(u n))) = "
      using LIMSEQ_unique by auto

    have "¬(liminf u = -   limsup u = )"
    proof (rule ccontr, auto)
      assume "liminf u = -" "limsup u = "
      have "N. n  N. m  N. Gromov_product_at 0 (u m) (u n)  1"
        using that unfolding Gromov_converging_at_boundary_def by blast
      then obtain N where N: "m n. m  N  n  N  Gromov_product_at 0 (u m) (u n)  1"
        by auto
      have "n  N. ereal(u n) > ereal 0"
        apply (rule limsup_obtain) unfolding ‹limsup u =  by auto
      then obtain n where n: "n  N" "u n > 0" by auto

      have "n  N. ereal(u n) < ereal 0"
        apply (rule liminf_obtain) unfolding ‹liminf u = - by auto
      then obtain m where m: "m  N" "u m < 0" by auto

      have "Gromov_product_at 0 (u m) (u n) = 0"
        unfolding Gromov_product_at_def dist_real_def using m n by auto
      then show False using N[OF m(1) n(1)] by auto
    qed
    then have "liminf u =   limsup u = - "
      using A B by auto
    then show ?thesis
      by (simp add: Liminf_PInfty Limsup_MInfty)
  qed
  show ?thesis using L A B by auto
qed

text ‹There is one single point at infinity in the Gromov completion of reals, i.e., two
sequences tending to infinity are equivalent.›

lemma real_Gromov_completion_rel_PInf:
  fixes u v::"nat  real"
  assumes "u  " "v  "
  shows "Gromov_completion_rel u v"
proof -
  have *: "Gromov_product_at 0 m n  min m n" for m n::real
    unfolding Gromov_product_at_def dist_real_def by auto
  have **: "Gromov_product_at a m n  min m n - abs a" for m n a::real
    using Gromov_product_at_diff1[of 0 m n a] *[of m n] by auto
  have "(λn. Gromov_product_at a (u n) (v n))  " for a
  proof (rule tendsto_sandwich[of "λn. min (u n) (v n) - abs a" _ _ "λn. "])
    have "ereal (min (u n) (v n) - ¦a¦)  ereal (Gromov_product_at a (u n) (v n))" for n
      using **[of "u n" "v n" a] by auto
    then show "F n in sequentially. ereal (min (u n) (v n) - ¦a¦)  ereal (Gromov_product_at a (u n) (v n))"
      by auto
    have "(λx. min (ereal(u x)) (ereal (v x)) - ereal ¦a¦)  min   - ereal ¦a¦"
      apply (intro tendsto_intros) using assms by auto
    then show "(λx. ereal (min (u x) (v x) - ¦a¦))  "
      apply auto unfolding ereal_minus(1)[symmetric] by auto
  qed (auto)
  moreover have "Gromov_converging_at_boundary u" "Gromov_converging_at_boundary v"
    using real_Gromov_converging_to_boundary assms by auto
  ultimately show ?thesis unfolding Gromov_completion_rel_def by auto
qed

text ‹There is one single point at minus infinity in the Gromov completion of reals, i.e., two
sequences tending to minus infinity are equivalent.›

lemma real_Gromov_completion_rel_MInf:
  fixes u v::"nat  real"
  assumes "u  -" "v  -"
  shows "Gromov_completion_rel u v"
proof -
  have *: "Gromov_product_at 0 m n  - max m n" for m n::real
    unfolding Gromov_product_at_def dist_real_def by auto
  have **: "Gromov_product_at a m n  - max m n - abs a" for m n a::real
    using Gromov_product_at_diff1[of 0 m n a] *[of m n] by auto
  have "(λn. Gromov_product_at a (u n) (v n))  " for a
  proof (rule tendsto_sandwich[of "λn. min (-u n) (-v n) - abs a" _ _ "λn. "])
    have "ereal (min (-u n) (-v n) - ¦a¦)  ereal (Gromov_product_at a (u n) (v n))" for n
      using **[of "u n" "v n" a] by auto
    then show "F n in sequentially. ereal (min (-u n) (-v n) - ¦a¦)  ereal (Gromov_product_at a (u n) (v n))"
      by auto
    have "(λx. min (-ereal(u x)) (-ereal (v x)) - ereal ¦a¦)  min (-(-)) (-(-)) - ereal ¦a¦"
      apply (intro tendsto_intros) using assms by auto
    then show "(λx. ereal (min (-u x) (-v x) - ¦a¦))  "
      apply auto unfolding ereal_minus(1)[symmetric] by auto
  qed (auto)
  moreover have "Gromov_converging_at_boundary u" "Gromov_converging_at_boundary v"
    using real_Gromov_converging_to_boundary assms by auto
  ultimately show ?thesis unfolding Gromov_completion_rel_def by auto
qed

text ‹It follows from the two lemmas above that the Gromov completion of reals is obtained by
adding one single point at infinity and one single point at minus infinity. Hence, it is in
bijection with the extended reals.›

function to_real_Gromov_completion::"ereal  real Gromov_completion"
  where "to_real_Gromov_completion (ereal r) = to_Gromov_completion r"
  | "to_real_Gromov_completion () = abs_Gromov_completion (λn. n)"
  | "to_real_Gromov_completion (-) = abs_Gromov_completion (λn. -n)"
by (auto intro: ereal_cases)
termination by standard (rule wf_empty)

text ‹To prove the bijectivity, we prove by hand injectivity and surjectivity using the above
lemmas.›

lemma bij_to_real_Gromov_completion:
  "bij to_real_Gromov_completion"
proof -
  have [simp]: "Gromov_completion_rel (λn. n) (λn. n)"
    by (intro real_Gromov_completion_rel_PInf tendsto_intros)
  have [simp]: "Gromov_completion_rel (λn. -real n) (λn. -real n)"
    by (intro real_Gromov_completion_rel_MInf tendsto_intros)

  have "x. to_real_Gromov_completion x = y" for y
  proof (cases y)
    case (to_Gromov_completion x)
    then have "y = to_real_Gromov_completion x" by auto
    then show ?thesis by blast
  next
    case boundary
    define u where u: "u = rep_Gromov_completion y"
    have y: "abs_Gromov_completion u = y" "Gromov_completion_rel u u"
      unfolding u using Quotient3_abs_rep[OF Quotient3_Gromov_completion]
      Quotient3_rep_reflp[OF Quotient3_Gromov_completion] by auto
    have "Gromov_converging_at_boundary u"
      using u boundary by (simp add: Gromov_boundary_rep_converging)
    then have "(u  )  (u  - )" using real_Gromov_converging_to_boundary by auto
    then show ?thesis
    proof
      assume "u  "
      have "abs_Gromov_completion (λn. n) = abs_Gromov_completion u "
        apply (rule Quotient3_rel_abs[OF Quotient3_Gromov_completion])
        by (intro real_Gromov_completion_rel_PInf[OF _ u  ] tendsto_intros)
      then have "to_real_Gromov_completion  = y"
        unfolding y by auto
      then show ?thesis by blast
    next
      assume "u  -"
      have "abs_Gromov_completion (λn. -real n) = abs_Gromov_completion u "
        apply (rule Quotient3_rel_abs[OF Quotient3_Gromov_completion])
        by (intro real_Gromov_completion_rel_MInf[OF _ u  -] tendsto_intros)
      then have "to_real_Gromov_completion (-) = y"
        unfolding y by auto
      then show ?thesis by blast
    qed
  qed
  then have "surj to_real_Gromov_completion"
    unfolding surj_def by metis

  have "to_real_Gromov_completion   Gromov_boundary"
       "to_real_Gromov_completion (-)  Gromov_boundary"
    by (auto intro!: abs_Gromov_completion_in_Gromov_boundary tendsto_intros simp add: real_Gromov_converging_to_boundary)
  moreover have "to_real_Gromov_completion   to_real_Gromov_completion (-)"
  proof -
    have "Gromov_product_at 0 (real n) (-real n) = 0" for n::nat
      unfolding Gromov_product_at_def dist_real_def by auto
    then have *: "(λn. ereal(Gromov_product_at 0 (real n) (-real n)))  ereal 0" by auto
    have "¬((λn. Gromov_product_at 0 (real n) (-real n))  )"
      using LIMSEQ_unique[OF *] by fastforce
    then have "¬(Gromov_completion_rel (λn. n) (λn. -n))"
      unfolding Gromov_completion_rel_def by auto (metis nat.simps(3) of_nat_0 of_nat_eq_0_iff)
    then show ?thesis
      using Quotient3_rel[OF Quotient3_Gromov_completion, of "λn. n" "λn. -real n"] by auto
  qed
  ultimately have "x = y" if "to_real_Gromov_completion x = to_real_Gromov_completion y" for x y
    using that injD[OF to_Gromov_completion_inj] apply (cases x y rule: ereal2_cases)
    by (auto) (metis not_in_Gromov_boundary')+
  then have "inj to_real_Gromov_completion"
    unfolding inj_def by auto
  then show "bij to_real_Gromov_completion"
    using ‹surj to_real_Gromov_completion› by (simp add: bijI)
qed

text ‹Next, we prove that we have a homeomorphism. By compactness of ereals, it suffices to show
that the inclusion map is continuous everywhere. It would be a pain to distinguish all the time if points are
at infinity or not, we rather use a criterion saying that it suffices to prove sequential
continuity for sequences taking values in a dense subset of the space, here we take the reals.
Hence, it suffices to show that if a sequence of reals $v_n$ converges to a limit $a$ in the
extended reals, then the image of $v_n$ in the Gromov completion (which is an inner point) converges
to the point corresponding to $a$. We treat separately the cases $a\in \mathbb{R}$, $a = \infty$ and
$a = -\infty$. In the first case, everything is trivial. In the other cases, we have characterized
in general sequences inside the space that converge to a boundary point, as sequences in the equivalence
class defining this boundary point. Since we have described explicitly these equivalence classes in
the case of the Gromov completion of the reals (they are respectively the sequences tending to
$\infty$ and to $-\infty$), the result follows readily without any additional computation.›

proposition homeo_to_real_Gromov_completion:
  "homeomorphism_on UNIV to_real_Gromov_completion"
proof (rule homeomorphism_on_compact)
  show "inj to_real_Gromov_completion"
    using bij_to_real_Gromov_completion by (simp add: bij_betw_def)
  show "compact (UNIV::ereal set)"
    by (simp add: compact_UNIV)
  show "continuous_on UNIV to_real_Gromov_completion"
  proof (rule continuous_on_extension_sequentially[of _ "{-<..<}"], auto)
    fix u::"nat  ereal" and b::ereal assume u: "n. u n  -   u n  " "u  b"
    define v where "v = (λn. real_of_ereal (u n))"
    have uv: "u n = ereal (v n)" for n
      using u unfolding v_def by (simp add: ereal_infinity_cases ereal_real)
    show "(λn. to_real_Gromov_completion (u n))  to_real_Gromov_completion b"
    proof (cases b)
      case (real r)
      then show ?thesis using u  b unfolding uv by auto
    next
      case PInf
      then have *: "(λn. ereal (v n))  " using u  b unfolding uv by auto
      have A: "Gromov_completion_rel real v" "Gromov_completion_rel real real" "Gromov_completion_rel v v"
        by (auto intro!: real_Gromov_completion_rel_PInf * tendsto_intros)
      then have B: "abs_Gromov_completion v = abs_Gromov_completion real"
        using Quotient3_rel_abs[OF Quotient3_Gromov_completion] by force
      then show ?thesis using u  b PInf
        unfolding uv apply auto
        apply (subst Gromov_completion_converge_to_boundary)
        using id_nat_ereal_tendsto_PInf real_Gromov_converging_to_boundary A B by auto
    next
      case MInf
      then have *: "(λn. ereal (v n))  -" using u  b unfolding uv by auto
      have A: "Gromov_completion_rel (λn. -real n) v" "Gromov_completion_rel (λn. -real n) (λn. -real n)" "Gromov_completion_rel v v"
        by (auto intro!: real_Gromov_completion_rel_MInf * tendsto_intros)
      then have B: "abs_Gromov_completion v = abs_Gromov_completion (λn. -real n)"
        using Quotient3_rel_abs[OF Quotient3_Gromov_completion] by force
      then show ?thesis using u  b MInf
        unfolding uv apply auto
        apply (subst Gromov_completion_converge_to_boundary)
        using id_nat_ereal_tendsto_PInf real_Gromov_converging_to_boundary A B
        by (auto simp add: ereal_minus_real_tendsto_MInf)
    qed
  qed
qed

end (*of theory Gromov_Boundary*)

Theory Boundary_Extension

(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
    License: BSD
*)

theory Boundary_Extension
  imports Morse_Gromov_Theorem Gromov_Boundary
begin

section ‹Extension of quasi-isometries to the boundary›

text ‹In this section, we show that a quasi-isometry between geodesic Gromov hyperbolic spaces
extends to a homeomorphism between their boundaries.›

text ‹Applying a quasi-isometry on a geodesic triangle essentially sends it to a geodesic triangle,
in hyperbolic spaces. It follows that, up to an additive constant, the Gromov product, which is the
distance to the center of the triangle, is multiplied by a constant between $\lambda^{-1}$ and
$\lambda$ when one applies a quasi-isometry. This argument is given in the next lemma. This implies
that two points are close in the Gromov completion if and only if their images are also close in the
Gromov completion of the image. Essentially, this lemma implies that a quasi-isometry has a
continuous extension to the Gromov boundary, which is a homeomorphism.›

lemma Gromov_product_at_quasi_isometry:
  fixes f::"'a::Gromov_hyperbolic_space_geodesic  'b::Gromov_hyperbolic_space_geodesic"
  assumes "lambda C-quasi_isometry f"
  shows "Gromov_product_at (f x) (f y) (f z)  Gromov_product_at x y z / lambda - 187 * lambda^2 * (C + deltaG(TYPE('a)) + deltaG(TYPE('b)))"
        "Gromov_product_at (f x) (f y) (f z)  lambda * Gromov_product_at x y z + 187 * lambda^2 * (C + deltaG(TYPE('a)) + deltaG(TYPE('b)))"
proof -
  have "lambda  1" "C  0" using quasi_isometry_onD[OF assms(1)] by auto
  define D where "D = 92 * lambda^2 * (C + deltaG(TYPE('b)))"
  have Dxy: "hausdorff_distance (f`{x--y}) {f x--f y}  D"
    unfolding D_def apply (rule geodesic_quasi_isometric_image[OF assms(1)]) by auto
  have Dyz: "hausdorff_distance (f`{y--z}) {f y--f z}  D"
    unfolding D_def apply (rule geodesic_quasi_isometric_image[OF assms(1)]) by auto
  have Dxz: "hausdorff_distance (f`{x--z}) {f x--f z}  D"
    unfolding D_def apply (rule geodesic_quasi_isometric_image[OF assms(1)]) by auto

  define E where "E = (lambda * (4 * deltaG(TYPE('a))) + C) + D"
  have "E  0" unfolding E_def D_def using lambda  1 C  0 by auto
  obtain w where w: "infdist w {x--y}  4 * deltaG(TYPE('a))"
                    "infdist w {x--z}  4 * deltaG(TYPE('a))"
                    "infdist w {y--z}  4 * deltaG(TYPE('a))"
                    "dist w x = Gromov_product_at x y z"
    using slim_triangle[of "{x--y}" x y "{x--z}" z "{y--z}"] by auto
  have "infdist (f w) {f x--f y}  infdist (f w) (f`{x--y}) + hausdorff_distance (f`{x--y}) {f x--f y}"
    by (intro mono_intros quasi_isometry_on_bounded[OF quasi_isometry_on_subset[OF assms(1)], of "{x--y}"], auto)
  also have "...  (lambda * infdist w {x--y} + C) + D"
    apply (intro mono_intros) using quasi_isometry_on_infdist[OF assms(1)] Dxy by auto
  also have "...  (lambda * (4 * deltaG(TYPE('a))) + C) + D"
    apply (intro mono_intros) using w lambda  1 by auto
  finally have Exy: "infdist (f w) {f x--f y}  E" unfolding E_def by auto

  have "infdist (f w) {f y--f z}  infdist (f w) (f`{y--z}) + hausdorff_distance (f`{y--z}) {f y--f z}"
    by (intro mono_intros quasi_isometry_on_bounded[OF quasi_isometry_on_subset[OF assms(1)], of "{y--z}"], auto)
  also have "...  (lambda * infdist w {y--z} + C) + D"
    apply (intro mono_intros) using quasi_isometry_on_infdist[OF assms(1)] Dyz by auto
  also have "...  (lambda * (4 * deltaG(TYPE('a))) + C) + D"
    apply (intro mono_intros) using w lambda  1 by auto
  finally have Eyz: "infdist (f w) {f y--f z}  E" unfolding E_def by auto

  have "infdist (f w) {f x--f z}  infdist (f w) (f`{x--z}) + hausdorff_distance (f`{x--z}) {f x--f z}"
    by (intro mono_intros quasi_isometry_on_bounded[OF quasi_isometry_on_subset[OF assms(1)], of "{x--z}"], auto)
  also have "...  (lambda * infdist w {x--z} + C) + D"
    apply (intro mono_intros) using quasi_isometry_on_infdist[OF assms(1)] Dxz by auto
  also have "...  (lambda * (4 * deltaG(TYPE('a))) + C) + D"
    apply (intro mono_intros) using w lambda  1 by auto
  finally have Exz: "infdist (f w) {f x--f z}  E" unfolding E_def by auto

  have "2 * ((1/lambda * dist w x - C))  2 * dist (f w) (f x)"
    using quasi_isometry_onD(2)[OF assms(1), of w x] by auto
  also have "... = (dist (f w) (f x) + dist (f w) (f y)) + (dist (f w) (f x) + dist (f w) (f z)) - (dist (f w) (f y) + dist (f w) (f z))"
    by auto
  also have "...  (dist (f x) (f y) + 2 * infdist (f w) {f x--f y}) + (dist (f x) (f z) + 2 * infdist (f w) {f x--f z}) - dist (f y) (f z)"
    by (intro geodesic_segment_distance mono_intros, auto)
  also have "...  2 * Gromov_product_at (f x) (f y) (f z) + 4 * E"
    unfolding Gromov_product_at_def using Exy Exz by (auto simp add: algebra_simps divide_simps)
  finally have *: "Gromov_product_at x y z / lambda - C - 2 * E  Gromov_product_at (f x) (f y) (f z)"
    unfolding w(4) by simp

  have "2 * Gromov_product_at (f x) (f y) (f z) - 2 * E  2 * Gromov_product_at (f x) (f y) (f z) - 2 * infdist (f w) {f y--f z}"
    using Eyz by auto
  also have "... = dist (f x) (f y) + dist (f x) (f z) - (dist (f y) (f z) + 2 * infdist (f w) {f y--f z})"
    unfolding Gromov_product_at_def by (auto simp add: algebra_simps divide_simps)
  also have "...  (dist (f w) (f x) + dist (f w) (f y)) + (dist (f w) (f x) + dist (f w) (f z)) - (dist (f w) (f y) + dist (f w) (f z))"
    by (intro geodesic_segment_distance mono_intros, auto)
  also have "... = 2 * dist (f w) (f x)"
    by auto
  also have "...  2 * (lambda * dist w x + C)"
    using quasi_isometry_onD(1)[OF assms(1), of w x] by auto
  finally have "Gromov_product_at (f x) (f y) (f z)  lambda * dist w x + C + E"
    by auto
  then have **: "Gromov_product_at (f x) (f y) (f z)  lambda * Gromov_product_at x y z + C + 2 * E"
    unfolding w(4) using E  0 by auto

  have "C + 2 * E = 3 * 1 * C + 8 * lambda * deltaG(TYPE('a)) + 184 * lambda^2 * C + 184 * lambda^2 * deltaG(TYPE('b))"
    unfolding E_def D_def by (auto simp add: algebra_simps)
  also have "...  3 * lambda^2 * C + 187 * lambda^2 * deltaG(TYPE('a)) + 184 * lambda^2 * C + 187 * lambda^2 * deltaG(TYPE('b))"
    apply (intro mono_intros) using lambda  1 C  0 by auto
  finally have I: "C + 2 * E  187 * lambda^2 * (C + deltaG(TYPE('a)) + deltaG(TYPE('b)))"
    by (auto simp add: algebra_simps)

  show "Gromov_product_at (f x) (f y) (f z)  Gromov_product_at x y z / lambda - 187 * lambda^2 * (C + deltaG(TYPE('a)) + deltaG(TYPE('b)))"
    using * I by auto
  show "Gromov_product_at (f x) (f y) (f z)  lambda * Gromov_product_at x y z + 187 * lambda^2 * (C + deltaG(TYPE('a)) + deltaG(TYPE('b)))"
    using ** I by auto
qed

lemma Gromov_converging_at_infinity_quasi_isometry:
  fixes f::"'a::Gromov_hyperbolic_space_geodesic  'b::Gromov_hyperbolic_space_geodesic"
  assumes "lambda C-quasi_isometry f"
  shows "Gromov_converging_at_boundary (λn. f (u n))  Gromov_converging_at_boundary u"
proof
  assume "Gromov_converging_at_boundary u"
  show "Gromov_converging_at_boundary (λn. f (u n))"
  proof (rule Gromov_converging_at_boundaryI[of "f (basepoint)"])
    have "lambda  1" "C  0" using quasi_isometry_onD[OF assms(1)] by auto
    define D where "D = 187 * lambda^2 * (C + deltaG(TYPE('a)) + deltaG(TYPE('b)))"
    fix M::real
    obtain M2::real where M2: "M = M2/lambda - D"
      using lambda  1 by (auto simp add: algebra_simps divide_simps)
    obtain N where N: "m n. m  N  n  N  Gromov_product_at basepoint (u m) (u n)  M2"
      using ‹Gromov_converging_at_boundary u unfolding Gromov_converging_at_boundary_def by blast
    have "Gromov_product_at (f basepoint) (f (u m)) (f (u n))  M" if "m  N" "n  N" for m n
    proof -
      have "M  Gromov_product_at basepoint (u m) (u n)/lambda - D"
        unfolding M2 using N[OF that] lambda  1 by (auto simp add: divide_simps)
      also have "...  Gromov_product_at (f basepoint) (f (u m)) (f (u n))"
        unfolding D_def by (rule Gromov_product_at_quasi_isometry[OF assms(1)])
      finally show ?thesis by simp
    qed
    then show "N. n  N. m  N. M  Gromov_product_at (f basepoint) (f (u m)) (f (u n))"
      unfolding comp_def by auto
  qed
next
  assume "Gromov_converging_at_boundary (λn. f (u n))"
  show "Gromov_converging_at_boundary u"
  proof (rule Gromov_converging_at_boundaryI[of "basepoint"])
    have "lambda  1" "C  0" using quasi_isometry_onD[OF assms(1)] by auto
    define D where "D = 187 * lambda^2 * (C + deltaG(TYPE('a)) + deltaG(TYPE('b)))"
    fix M::real
    define M2 where "M2 = lambda * M + D"
    have M2: "M = (M2 - D)/lambda" unfolding M2_def using lambda  1 by (auto simp add: algebra_simps divide_simps)
    obtain N where N: "m n. m  N  n  N  Gromov_product_at (f basepoint) (f (u m)) (f (u n))  M2"
      using ‹Gromov_converging_at_boundary (λn. f (u n)) unfolding Gromov_converging_at_boundary_def by blast
    have "Gromov_product_at basepoint (u m) (u n)  M" if "m  N" "n  N" for m n
    proof -
      have "M2  Gromov_product_at (f basepoint) (f (u m)) (f (u n))"
        using N[OF that] by auto
      also have "...  lambda * Gromov_product_at basepoint (u m) (u n) + D"
        unfolding D_def by (rule Gromov_product_at_quasi_isometry[OF assms(1)])
      finally show "M  Gromov_product_at basepoint (u m) (u n)"
        unfolding M2 using lambda  1 by (auto simp add: algebra_simps divide_simps)
    qed
    then show "N. n  N. m  N. Gromov_product_at basepoint (u m) (u n)  M"
      by auto
  qed
qed

text ‹We define the extension to the completion of a function $f: X \to Y$ where $X$ and $Y$
are geodesic Gromov-hyperbolic spaces, as a function from $X \cup \partial X$ to $Y\cup \partial Y$,
as follows. If $x$ is in the space, we just use $f(x)$ (with the suitable coercions for the
definition). Otherwise, we wish to define $f(x)$ as the limit of $f(u_n)$ for all sequences tending
to $x$. For the definition, we use one such sequence chosen arbitrarily (this is the role of
\verb+rep_Gromov_completion x+ below, it is indeed a sequence in the space tending to $x$), and
we use the limit of $f(u_n)$ (if it exists, otherwise the framework will choose some point for us
but it will make no sense whatsoever).

For quasi-isometries, we have indeed that $f(u_n)$ converges if $u_n$ converges to a boundary point,
by \verb+Gromov_converging_at_infinity_quasi_isometry+, so this definition is meaningful. Moreover,
continuity of the extension follows readily from this (modulo a suitable criterion for continuity
based on sequences convergence, established in \verb+continuous_at_extension_sequentially'+).›

definition Gromov_extension::"('a::Gromov_hyperbolic_space  'b::Gromov_hyperbolic_space)  ('a Gromov_completion  'b Gromov_completion)"
  where "Gromov_extension f x = (if x  Gromov_boundary then lim (to_Gromov_completion o f o (rep_Gromov_completion x))
                                 else to_Gromov_completion (f (from_Gromov_completion x)))"

lemma Gromov_extension_inside_space [simp]:
  "Gromov_extension f (to_Gromov_completion x) = to_Gromov_completion (f x)"
unfolding Gromov_extension_def by auto

lemma Gromov_extension_id [simp]:
  "Gromov_extension (id::'a::Gromov_hyperbolic_space  'a) = id"
  "Gromov_extension (λx::'a. x) = (λx. x)"
proof -
  have "Gromov_extension id x = id x" for x::"'a Gromov_completion"
    unfolding Gromov_extension_def comp_def
    using limI rep_Gromov_completion_limit by (auto simp add: to_from_Gromov_completion)
  then show "Gromov_extension (id::'a  'a) = id"
    by auto
  then show "Gromov_extension (λx::'a. x) = (λx. x)"
    unfolding id_def by auto
qed

text ‹The Gromov extension of a quasi-isometric map sends the boundary to the boundary.›

lemma Gromov_extension_quasi_isometry_boundary_to_boundary:
  fixes f::"'a::Gromov_hyperbolic_space_geodesic  'b::Gromov_hyperbolic_space_geodesic"
  assumes "lambda C-quasi_isometry f"
          "x  Gromov_boundary"
  shows "(Gromov_extension f) x  Gromov_boundary"
proof -
  have *: "Gromov_converging_at_boundary (λn. f (rep_Gromov_completion x n))"
    by (simp add: Gromov_converging_at_infinity_quasi_isometry[OF assms(1)] Gromov_boundary_rep_converging assms(2))
  show ?thesis
    unfolding Gromov_extension_def using assms(2) unfolding comp_def apply auto
    by (metis Gromov_converging_at_boundary_converges * limI)
qed

text ‹If the original function is continuous somewhere inside the space, then its Gromov extension
is continuous at the corresponding point inside the completion. This is clear as the original space
is open in the Gromov completion, but the proof requires to go back and forth between one space
and the other.›

lemma Gromov_extension_continuous_inside:
  fixes f::"'a::Gromov_hyperbolic_space  'b::Gromov_hyperbolic_space"
  assumes "continuous (at x within S) f"
  shows "continuous (at (to_Gromov_completion x) within (to_Gromov_completion`S)) (Gromov_extension f)"
proof -
  have *: "continuous (at (to_Gromov_completion x) within (to_Gromov_completion`S)) (to_Gromov_completion o f o from_Gromov_completion)"
    apply (intro continuous_within_compose, auto)
    using from_Gromov_completion_continuous(3) continuous_at_imp_continuous_within apply blast
    using assms apply (simp add: continuous_within_topological)
    using continuous_at_imp_continuous_within continuous_on_eq_continuous_within to_Gromov_completion_continuous by blast
  have "(to_Gromov_completion o f o from_Gromov_completion) y = Gromov_extension f y"
    if "y  range to_Gromov_completion" for y
    unfolding comp_def using that by auto
  moreover have "eventually (λy. y  range to_Gromov_completion) (at (to_Gromov_completion x) within (to_Gromov_completion`S))"
    using to_Gromov_completion_range_open eventually_at_topological by blast
  ultimately have **: "eventually (λy. (to_Gromov_completion o f o from_Gromov_completion) y = Gromov_extension f y)
                        (at (to_Gromov_completion x) within (to_Gromov_completion`S))"
    by (rule eventually_mono[rotated])
  show ?thesis
    by (rule continuous_within_cong[OF * **], auto)
qed

text ‹The extension to the boundary of a quasi-isometry is continuous. This is a nontrivial
statement, but it follows readily from the fact we have already proved that sequences converging
at the boundary are mapped to sequences converging to the boundary. The proof is expressed using
a convenient continuity criterion for which we only need to control what happens for sequences
inside the space.›

proposition Gromov_extension_continuous:
  fixes f::"'a::Gromov_hyperbolic_space_geodesic  'b::Gromov_hyperbolic_space_geodesic"
  assumes "lambda C-quasi_isometry f"
          "x  Gromov_boundary"
  shows "continuous (at x) (Gromov_extension f)"
proof -
  have "continuous (at x within (range to_Gromov_completion  Gromov_boundary)) (Gromov_extension f)"
  proof (rule continuous_at_extension_sequentially'[OF x  Gromov_boundary›])
    fix b::"'a Gromov_completion" assume "b  Gromov_boundary"
    show "u. (n. u n  range to_Gromov_completion)  u  b  (λn. Gromov_extension f (u n))  Gromov_extension f b"
      apply (rule exI[of _ "to_Gromov_completion o (rep_Gromov_completion b)"], auto simp add: comp_def)
      unfolding Gromov_completion_converge_to_boundary[OF b  Gromov_boundary›]
      using Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion] apply auto[1]
      unfolding Gromov_extension_def using b  Gromov_boundary› unfolding comp_def
      by (auto simp add: convergent_LIMSEQ_iff[symmetric] Gromov_boundary_rep_converging Gromov_converging_at_infinity_quasi_isometry[OF assms(1)]
               intro!: Gromov_converging_at_boundary_converges')
  next
    fix u and b::"'a Gromov_completion"
    assume u: "n. u n  range to_Gromov_completion" "b  Gromov_boundary" "u  b"
    define v where "v = (λn. from_Gromov_completion (u n))"
    have v: "u n = to_Gromov_completion (v n)" for n
      using u(1) unfolding v_def by (simp add: f_inv_into_f from_Gromov_completion_def)

    show "convergent (λn. Gromov_extension f (u n))"
      using u unfolding v
      apply (auto intro!: Gromov_converging_at_boundary_converges' simp add: Gromov_converging_at_infinity_quasi_isometry[OF assms(1)])
      using Gromov_boundary_abs_converging Gromov_completion_converge_to_boundary by blast
  qed
  then show ?thesis by (simp add: Gromov_boundary_def)
qed

text ‹Combining the two previous statements on continuity inside the space and continuity at the
boundary, we deduce that a continuous quasi-isometry extends to a continuous map everywhere.›

proposition Gromov_extension_continuous_everywhere:
  fixes f::"'a::Gromov_hyperbolic_space_geodesic  'b::Gromov_hyperbolic_space_geodesic"
  assumes "lambda C-quasi_isometry f"
          "continuous_on UNIV f"
  shows "continuous_on UNIV (Gromov_extension f)"
using Gromov_extension_continuous_inside Gromov_extension_continuous[OF assms(1)]
by (metis UNIV_I assms(2) continuous_on_eq_continuous_within continuous_within_open not_in_Gromov_boundary rangeI to_Gromov_completion_range_open)

text ‹The extension to the boundary is functorial on the category of quasi-isometries, i.e., the
composition of extensions is the extension of the composition. This is clear inside the space, and
it follows from the continuity at boundary points.›

lemma Gromov_extension_composition:
  fixes f::"'a::Gromov_hyperbolic_space_geodesic  'b::Gromov_hyperbolic_space_geodesic"
    and g::"'b::Gromov_hyperbolic_space_geodesic  'c::Gromov_hyperbolic_space_geodesic"
  assumes "lambda C-quasi_isometry f"
          "mu D-quasi_isometry g"
  shows "Gromov_extension (g o f) = Gromov_extension g o Gromov_extension f"
proof -
  have In: "Gromov_extension (g o f) x = (Gromov_extension g o Gromov_extension f) x" if H: "x  range to_Gromov_completion" for x
  proof -
    obtain y where *: "x = to_Gromov_completion y"
      using H by auto
    show ?thesis
      unfolding * comp_def by auto
  qed
  moreover have "Gromov_extension (g o f) x = (Gromov_extension g o Gromov_extension f) x" if H: "x  Gromov_boundary" for x
  proof -
    obtain u where u: "n. u n  range to_Gromov_completion" "u  x"
      using closure_sequential to_Gromov_completion_range_dense by blast
    have "(λn. Gromov_extension (g o f) (u n))  Gromov_extension (g o f) x"
      using continuous_within_tendsto_compose[OF Gromov_extension_continuous[OF quasi_isometry_on_compose[OF assms(1) assms(2), simplified] H] _ u(2)] by simp
    then have A: "(λn. (Gromov_extension g) ((Gromov_extension f) (u n)))  Gromov_extension (g o f) x"
      unfolding In[OF u(1)] unfolding comp_def by auto

    have *: "(λn. (Gromov_extension f) (u n))  (Gromov_extension f) x"
      using continuous_within_tendsto_compose[OF Gromov_extension_continuous[OF assms(1) H] _ u(2)] by simp
    have "(λn. (Gromov_extension g) ((Gromov_extension f) (u n)))  Gromov_extension g ((Gromov_extension f) x)"
      using continuous_within_tendsto_compose[OF Gromov_extension_continuous[OF assms(2)] _ *]
      H Gromov_extension_quasi_isometry_boundary_to_boundary assms(1) by auto
    then show ?thesis using LIMSEQ_unique A comp_def by auto
  qed
  ultimately have "Gromov_extension (g o f) x = (Gromov_extension g o Gromov_extension f) x" for x
    using not_in_Gromov_boundary by force
  then show ?thesis by auto
qed

text ‹Now, we turn to the same kind of statement, but for homeomorphisms. We claim that if a
quasi-isometry $f$ is a homeomorphism on a subset $X$ of the space, then its extension is a
homeomorphism on $X$ union the boundary of the space.
For the proof, we have to show that a sequence $u_n$ tends to a point $x$
if and only if $f(u_n)$ tends to $f(x)$. We separate the cases $x$ in the boundary, and $x$ inside
the space. For $x$ in the boundary, we use a homeomorphism criterion expressed solely in terms
of sequences converging to the boundary, for which we already know everything.
For $x$ in the space, the proof is straightforward, but tedious.
We argue that eventually $u_n$ is in the space for the direct implication, or $f(u_n)$ is in the
space for the second implication, and then we use that $f$ is a homeomorphism inside the space to
conclude.›

lemma Gromov_extension_homeomorphism:
  fixes f::"'a::Gromov_hyperbolic_space_geodesic  'b::Gromov_hyperbolic_space_geodesic"
  assumes "lambda C-quasi_isometry f"
          "homeomorphism_on X f"
  shows "homeomorphism_on (to_Gromov_completion`X  Gromov_boundary) (Gromov_extension f)"
proof (rule homeomorphism_on_sequentially)
  fix x u assume H0: "x  to_Gromov_completion ` X  Gromov_boundary"
                    "n::nat. u n  to_Gromov_completion ` X  Gromov_boundary"
  then consider "x  Gromov_boundary" | "x  to_Gromov_completion`X" by auto
  then show "u  x = (λn. Gromov_extension f (u n))  Gromov_extension f x"
  proof (cases)
    text ‹First, consider the case where the limit point $x$ is in the boundary. We use a good
    criterion expressing everything in terms of sequences inside the space.›
    case 1
    show ?thesis
    proof (rule homeomorphism_on_extension_sequentially_precise[of "range to_Gromov_completion" Gromov_boundary])
      show "x  Gromov_boundary" by fact
      fix n::nat show "u n  range to_Gromov_completion  Gromov_boundary"
        unfolding Gromov_boundary_def by auto
    next
      fix u and b::"'a Gromov_completion"
      assume u: "n. u n  range to_Gromov_completion" "b  Gromov_boundary" "u  b"
      define v where "v = (λn. from_Gromov_completion (u n))"
      have v: "u n = to_Gromov_completion (v n)" for n
        using u(1) unfolding v_def by (simp add: f_inv_into_f from_Gromov_completion_def)
      show "convergent (λn. Gromov_extension f (u n))"
        using u unfolding v apply auto
        apply (rule Gromov_converging_at_boundary_converges')
        by (auto simp add: Gromov_converging_at_infinity_quasi_isometry[OF assms(1)] lim_imp_Gromov_converging_at_boundary)
    next
      fix u c
      assume u: "n. u n  range to_Gromov_completion" "c  Gromov_extension f ` Gromov_boundary" "(λn. Gromov_extension f (u n))  c"
      then have "c  Gromov_boundary" using Gromov_extension_quasi_isometry_boundary_to_boundary[OF assms(1)] by auto
      define v where "v = (λn. from_Gromov_completion (u n))"
      have v: "u n = to_Gromov_completion (v n)" for n
        using u(1) unfolding v_def by (simp add: f_inv_into_f from_Gromov_completion_def)
      have "Gromov_converging_at_boundary (λn. f (v n))"
        apply (rule lim_imp_Gromov_converging_at_boundary[OF _ c  Gromov_boundary›])
        using u(3) unfolding v by auto
      then show "convergent u"
        using u unfolding v
        by (auto intro!: Gromov_converging_at_boundary_converges' simp add: Gromov_converging_at_infinity_quasi_isometry[OF assms(1), symmetric])
    next
      fix b::"'a Gromov_completion" assume "b  Gromov_boundary"
      show "u. (n. u n  range to_Gromov_completion)  u  b  (λn. Gromov_extension f (u n))  Gromov_extension f b"
        apply (rule exI[of _ "to_Gromov_completion o (rep_Gromov_completion b)"], auto simp add: comp_def)
        unfolding Gromov_completion_converge_to_boundary[OF b  Gromov_boundary›]
        using Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion] apply auto[1]
        unfolding Gromov_extension_def using b  Gromov_boundary› unfolding comp_def
        by (auto simp add: convergent_LIMSEQ_iff[symmetric] Gromov_boundary_rep_converging Gromov_converging_at_infinity_quasi_isometry[OF assms(1)]
                 intro!: Gromov_converging_at_boundary_converges')
    qed
  next
    text ‹Next, consider the case where $x$ is inside the space. Then we show everything by going
    back and forth between the original space and its copy in the completion, and arguing that $f$
    is a homeomorphism on the original space.›
    case 2
    then have fx: "Gromov_extension f x  range to_Gromov_completion"
      using Gromov_extension_inside_space by blast
    have x: "x  range to_Gromov_completion"
      using "2" by blast
    show ?thesis
    proof
      assume H: "(λn. Gromov_extension f (u n))  Gromov_extension f x"
      then have fu_in: "eventually (λn. Gromov_extension f (u n)  range to_Gromov_completion) sequentially"
        using fx to_Gromov_completion_range_open H topological_tendstoD by fastforce
      have u_in: "eventually (λn. u n  range to_Gromov_completion) sequentially"
        using Gromov_extension_quasi_isometry_boundary_to_boundary[OF assms(1)] eventually_mono[OF fu_in]
        by (metis DiffE DiffI Gromov_boundary_def iso_tuple_UNIV_I)

      have B: "from_Gromov_completion (Gromov_extension f y) = f (from_Gromov_completion y)" if "Gromov_extension f y  range to_Gromov_completion" for y
        by (metis Gromov_extension_quasi_isometry_boundary_to_boundary Gromov_extension_def assms(1) from_to_Gromov_completion not_in_Gromov_boundary' rangeE that)
      have "(λn. from_Gromov_completion (Gromov_extension f (u n)))  from_Gromov_completion (Gromov_extension f x)"
        by (rule continuous_on_tendsto_compose[OF from_Gromov_completion_continuous(2) H fx fu_in])
      then have C: "(λn. f (from_Gromov_completion (u n)))  f (from_Gromov_completion x)"
        unfolding B[OF fx, symmetric] 
        by (force intro: Lim_transform_eventually eventually_mono[OF fu_in B]) 
      have "(λn. from_Gromov_completion (u n))  from_Gromov_completion x"
        apply (rule iffD2[OF homeomorphism_on_compose[OF assms(2)] C])
        using 2 apply auto
        by (metis (no_types, lifting) eventually_mono[OF u_in] H0(2) Un_iff f_inv_into_f from_to_Gromov_completion inv_into_into not_in_Gromov_boundary')
      then have L: "(λn. to_Gromov_completion (from_Gromov_completion (u n)))  to_Gromov_completion (from_Gromov_completion x)"
        using continuous_on_tendsto_compose[OF to_Gromov_completion_continuous] by auto

      have **: "to_Gromov_completion (from_Gromov_completion y) = y" if "y  range to_Gromov_completion" for y::"'a Gromov_completion"
        using Gromov_extension_quasi_isometry_boundary_to_boundary assms(1) that to_from_Gromov_completion by fastforce
      then have "eventually (λn. to_Gromov_completion (from_Gromov_completion (u n)) = u n) sequentially"
        using u_in eventually_mono by force
      then have "u  to_Gromov_completion (from_Gromov_completion x)"
        by (rule Lim_transform_eventually[OF L])
      then show "u  x"
        using ** by (simp add: x)
    next
      assume "u  x"
      then have u_in: "eventually (λn. u n  range to_Gromov_completion) sequentially"
        using x to_Gromov_completion_range_open topological_tendstoD by fastforce
      define y where "y = from_Gromov_completion x"
      have "y  X" unfolding y_def using 2 by auto
      then have *: "continuous (at y within X) f"
        using homeomorphism_on_continuous[OF assms(2)] continuous_on_eq_continuous_within by blast
      have **: "continuous (at x within to_Gromov_completion`X) (Gromov_extension f)"
        using Gromov_extension_continuous_inside[OF *] y_def 2 by auto

      show "(λn. Gromov_extension f (u n))  Gromov_extension f x"
        apply (rule continuous_within_tendsto_compose[OF ** _ u  x])
        using u_in H0(2) by (metis (mono_tags, lifting) UnE eventually_mono f_inv_into_f not_in_Gromov_boundary')
    qed
  qed
qed

text ‹In particular, it follows that the extension to the boundary of a quasi-isometry is always
a homeomorphism, regardless of the continuity properties of the original map.›

proposition Gromov_extension_boundary_homeomorphism:
  fixes f::"'a::Gromov_hyperbolic_space_geodesic  'b::Gromov_hyperbolic_space_geodesic"
  assumes "lambda C-quasi_isometry f"
  shows "homeomorphism_on Gromov_boundary (Gromov_extension f)"
using Gromov_extension_homeomorphism[OF assms, of "{}"] by auto

text ‹When the quasi-isometric embedding is a quasi-isometric isomorphism, i.e., it is onto up
to a bounded distance $C$, then its Gromov extension is onto on the boundary. Indeed, a point
in the image boundary is a limit of a sequence inside the space. Perturbing by a bounded distance
(which does not change the asymptotic behavior), it is the limit of a sequence inside the image of
$f$. Then the preimage under $f$ of this sequence does converge, and its limit is sent by the
extension on the original point, proving the surjectivity.›

lemma Gromov_extension_onto:
  fixes f::"'a::Gromov_hyperbolic_space_geodesic  'b::Gromov_hyperbolic_space_geodesic"
  assumes "lambda C-quasi_isometry_between UNIV UNIV f"
          "y  Gromov_boundary"
  shows "x  Gromov_boundary. Gromov_extension f x = y"
proof -
  define u where "u = rep_Gromov_completion y"
  have *: "(λn. to_Gromov_completion (u n))  y"
    unfolding u_def using rep_Gromov_completion_limit by fastforce
  have "v. n. dist (f (v n)) (u n)  C"
    apply (intro choice) using quasi_isometry_betweenD(3)[OF assms(1)] by auto
  then obtain v where v: "n. dist (f (v n)) (u n)  C" by auto
  have *: "(λn. to_Gromov_completion (f (v n)))  y"
    apply (rule Gromov_converging_at_boundary_bounded_perturbation[OF * y  Gromov_boundary›])
    using v by (simp add: dist_commute)
  then have "Gromov_converging_at_boundary (λn. f (v n))"
    using assms(2) lim_imp_Gromov_converging_at_boundary by force
  then have "Gromov_converging_at_boundary v"
    using Gromov_converging_at_infinity_quasi_isometry[OF quasi_isometry_betweenD(1)[OF assms(1)]] by auto
  then obtain x where "x  Gromov_boundary" "(λn. to_Gromov_completion (v n))  x"
    using Gromov_converging_at_boundary_converges by blast
  then have "(λn. (Gromov_extension f) (to_Gromov_completion (v n)))  Gromov_extension f x"
    using isCont_tendsto_compose[OF Gromov_extension_continuous[OF quasi_isometry_betweenD(1)[OF assms(1)] x  Gromov_boundary›]] by fastforce
  then have "y = Gromov_extension f x"
    using * LIMSEQ_unique by auto
  then show ?thesis using x  Gromov_boundary› by auto
qed

lemma Gromov_extension_onto':
  fixes f::"'a::Gromov_hyperbolic_space_geodesic  'b::Gromov_hyperbolic_space_geodesic"
  assumes "lambda C-quasi_isometry_between UNIV UNIV f"
  shows "(Gromov_extension f)`Gromov_boundary = Gromov_boundary"
using Gromov_extension_onto[OF assms] Gromov_extension_quasi_isometry_boundary_to_boundary[OF quasi_isometry_betweenD(1)[OF assms]] by auto

text ‹Finally, we obtain that a quasi-isometry between two Gromov hyperbolic spaces induces a
homeomorphism of their boundaries.›

theorem Gromov_boundaries_homeomorphic:
  fixes f::"'a::Gromov_hyperbolic_space_geodesic  'b::Gromov_hyperbolic_space_geodesic"
  assumes "lambda C-quasi_isometry_between UNIV UNIV f"
  shows "(Gromov_boundary::'a Gromov_completion set) homeomorphic (Gromov_boundary::'b Gromov_completion set)"
using Gromov_extension_boundary_homeomorphism[OF quasi_isometry_betweenD(1)[OF assms]] Gromov_extension_onto'[OF assms]
unfolding homeomorphic_def homeomorphism_on_def by auto



section ‹Extensions of isometries to the boundary›

text ‹The results of the previous section can be improved for isometries, as there is no need for
geodesicity any more. We follow the same proofs as in the previous section›

text ‹An isometry preserves the Gromov product.›

lemma Gromov_product_isometry:
  assumes "isometry_on UNIV f"
  shows "Gromov_product_at (f x) (f y) (f z) = Gromov_product_at x y z"
unfolding Gromov_product_at_def by (simp add: isometry_onD[OF assms])

text ‹An isometry preserves convergence at infinity.›

lemma Gromov_converging_at_infinity_isometry:
  fixes f::"'a::Gromov_hyperbolic_space  'b::Gromov_hyperbolic_space"
  assumes "isometry_on UNIV f"
  shows "Gromov_converging_at_boundary (λn. f (u n))  Gromov_converging_at_boundary u"
proof
  assume *: "Gromov_converging_at_boundary u"
  show "Gromov_converging_at_boundary (λn. f (u n))"
    apply (rule Gromov_converging_at_boundaryI[of "f (basepoint)"])
    using * unfolding Gromov_converging_at_boundary_def Gromov_product_isometry[OF assms] by auto
next
  assume *: "Gromov_converging_at_boundary (λn. f (u n))"
  have **: "N. n  N. m  N. M  Gromov_product_at (f basepoint) (f (u m)) (f (u n))" for M
    using * unfolding Gromov_converging_at_boundary_def by auto
  show "Gromov_converging_at_boundary u"
    apply (rule Gromov_converging_at_boundaryI[of "basepoint"])
    using ** unfolding Gromov_converging_at_boundary_def Gromov_product_isometry[OF assms] by auto
qed

text ‹The Gromov extension of an isometry sends the boundary to the boundary.›

lemma Gromov_extension_isometry_boundary_to_boundary:
  fixes f::"'a::Gromov_hyperbolic_space  'b::Gromov_hyperbolic_space"
  assumes "isometry_on UNIV f"
          "x  Gromov_boundary"
  shows "(Gromov_extension f) x  Gromov_boundary"
proof -
  have *: "Gromov_converging_at_boundary (λn. f (rep_Gromov_completion x n))"
    by (simp add: Gromov_converging_at_infinity_isometry[OF assms(1)] Gromov_boundary_rep_converging assms(2))
  show ?thesis
    unfolding Gromov_extension_def using assms(2) unfolding comp_def apply auto
    by (metis Gromov_converging_at_boundary_converges * limI)
qed

text ‹The Gromov extension of an isometry is a homeomorphism. (We copy the proof for
quasi-isometries, with some simplifications.)›

lemma Gromov_extension_isometry_homeomorphism:
  fixes f::"'a::Gromov_hyperbolic_space  'b::Gromov_hyperbolic_space"
  assumes "isometry_on UNIV f"
  shows "homeomorphism_on UNIV (Gromov_extension f)"
proof (rule homeomorphism_on_sequentially)
  fix x u
  show "u  x = (λn. Gromov_extension f (u n))  Gromov_extension f x"
  proof (cases x)
    text ‹First, consider the case where the limit point $x$ is in the boundary. We use a good
    criterion expressing everything in terms of sequences inside the space.›
    case boundary
    show ?thesis
    proof (rule homeomorphism_on_extension_sequentially_precise[of "range to_Gromov_completion" Gromov_boundary])
      show "x  Gromov_boundary" by fact
      fix n::nat show "u n  range to_Gromov_completion  Gromov_boundary"
        unfolding Gromov_boundary_def by auto
    next
      fix u and b::"'a Gromov_completion"
      assume u: "n. u n  range to_Gromov_completion" "b  Gromov_boundary" "u  b"
      define v where "v = (λn. from_Gromov_completion (u n))"
      have v: "u n = to_Gromov_completion (v n)" for n
        using u(1) unfolding v_def by (simp add: f_inv_into_f from_Gromov_completion_def)
      show "convergent (λn. Gromov_extension f (u n))"
        using u unfolding v apply auto
        apply (rule Gromov_converging_at_boundary_converges')
        by (auto simp add: Gromov_converging_at_infinity_isometry[OF assms(1)] lim_imp_Gromov_converging_at_boundary)
    next
      fix u c
      assume u: "n. u n  range to_Gromov_completion" "c  Gromov_extension f ` Gromov_boundary" "(λn. Gromov_extension f (u n))  c"
      then have "c  Gromov_boundary" using Gromov_extension_isometry_boundary_to_boundary[OF assms(1)] by auto
      define v where "v = (λn. from_Gromov_completion (u n))"
      have v: "u n = to_Gromov_completion (v n)" for n
        using u(1) unfolding v_def by (simp add: f_inv_into_f from_Gromov_completion_def)
      have "Gromov_converging_at_boundary (λn. f (v n))"
        apply (rule lim_imp_Gromov_converging_at_boundary[OF _ c  Gromov_boundary›])
        using u(3) unfolding v by auto
      then show "convergent u"
        using u unfolding v
        by (auto intro!: Gromov_converging_at_boundary_converges' simp add: Gromov_converging_at_infinity_isometry[OF assms(1), symmetric])
    next
      fix b::"'a Gromov_completion" assume "b  Gromov_boundary"
      show "u. (n. u n  range to_Gromov_completion)  u  b  (λn. Gromov_extension f (u n))  Gromov_extension f b"
        apply (rule exI[of _ "to_Gromov_completion o (rep_Gromov_completion b)"], auto simp add: comp_def)
        unfolding Gromov_completion_converge_to_boundary[OF b  Gromov_boundary›]
        using Quotient3_abs_rep[OF Quotient3_Gromov_completion] Quotient3_rep_reflp[OF Quotient3_Gromov_completion] apply auto[1]
        unfolding Gromov_extension_def using b  Gromov_boundary› unfolding comp_def
        by (auto simp add: convergent_LIMSEQ_iff[symmetric] Gromov_boundary_rep_converging Gromov_converging_at_infinity_isometry[OF assms(1)]
                 intro!: Gromov_converging_at_boundary_converges')
    qed
  next
    text ‹Next, consider the case where $x$ is inside the space. Then we show everything by going
    back and forth between the original space and its copy in the completion, and arguing that $f$
    is a homeomorphism on the original space.›
    case (to_Gromov_completion xin)
    then have fx: "Gromov_extension f x  range to_Gromov_completion"
      using Gromov_extension_inside_space by blast
    have x: "x  range to_Gromov_completion"
      using to_Gromov_completion by blast
    show ?thesis
    proof
      assume H: "(λn. Gromov_extension f (u n))  Gromov_extension f x"
      then have fu_in: "eventually (λn. Gromov_extension f (u n)  range to_Gromov_completion) sequentially"
        using fx to_Gromov_completion_range_open H topological_tendstoD by fastforce
      have u_in: "eventually (λn. u n  range to_Gromov_completion) sequentially"
        using Gromov_extension_isometry_boundary_to_boundary[OF assms(1)] eventually_mono[OF fu_in]
        by (metis DiffE DiffI Gromov_boundary_def iso_tuple_UNIV_I)

      have B: "from_Gromov_completion (Gromov_extension f y) = f (from_Gromov_completion y)" if "Gromov_extension f y  range to_Gromov_completion" for y
        by (metis Gromov_extension_isometry_boundary_to_boundary Gromov_extension_def assms(1) from_to_Gromov_completion not_in_Gromov_boundary' rangeE that)
      have "(λn. from_Gromov_completion (Gromov_extension f (u n)))  from_Gromov_completion (Gromov_extension f x)"
        by (rule continuous_on_tendsto_compose[OF from_Gromov_completion_continuous(2) H fx fu_in])
      then have C: "(λn. f (from_Gromov_completion (u n)))  f (from_Gromov_completion x)"
        unfolding B[OF fx, symmetric] 
        by (force intro: Lim_transform_eventually eventually_mono[OF fu_in B])
      have "(λn. from_Gromov_completion (u n))  from_Gromov_completion x"
        apply (rule iffD2[OF homeomorphism_on_compose[OF isometry_on_homeomorphism(2)[OF assms]] C])
        using to_Gromov_completion by auto
      then have L: "(λn. to_Gromov_completion (from_Gromov_completion (u n)))  to_Gromov_completion (from_Gromov_completion x)"
        using continuous_on_tendsto_compose[OF to_Gromov_completion_continuous] by auto

      have **: "to_Gromov_completion (from_Gromov_completion y) = y" if "y  range to_Gromov_completion" for y::"'a Gromov_completion"
        using Gromov_extension_isometry_boundary_to_boundary assms(1) that to_from_Gromov_completion by fastforce
      then have "eventually (λn. to_Gromov_completion (from_Gromov_completion (u n)) = u n) sequentially"
        using u_in eventually_mono by force
      then have "u  to_Gromov_completion (from_Gromov_completion x)"
        by (rule Lim_transform_eventually[OF L])
      then show "u  x"
        using ** by (simp add: x)
    next
      assume "u  x"
      then have u_in: "eventually (λn. u n  range to_Gromov_completion) sequentially"
        using x to_Gromov_completion_range_open topological_tendstoD by fastforce
      define y where "y = from_Gromov_completion x"
      then have *: "continuous (at y) f"
        using homeomorphism_on_continuous[OF isometry_on_homeomorphism(2)[OF assms]] continuous_on_eq_continuous_within by blast
      have **: "continuous (at x within to_Gromov_completion`UNIV) (Gromov_extension f)"
        using Gromov_extension_continuous_inside[OF *] y_def to_Gromov_completion by auto

      show "(λn. Gromov_extension f (u n))  Gromov_extension f x"
        apply (rule continuous_within_tendsto_compose[OF ** _ u  x])
        using u_in by auto
    qed
  qed
qed

text ‹The composition of the Gromov extension of two isometries is the Gromov extension of the
composition.›

lemma Gromov_extension_isometry_on_composition:
  assumes "isometry_on UNIV f"
          "isometry_on UNIV g"
  shows "Gromov_extension (g o f) = Gromov_extension g o Gromov_extension f"
proof -
  have In: "Gromov_extension (g o f) x = (Gromov_extension g o Gromov_extension f) x" if H: "x  range to_Gromov_completion" for x
  proof -
    obtain y where *: "x = to_Gromov_completion y"
      using H by auto
    show ?thesis
      unfolding * comp_def by auto
  qed
  moreover have "Gromov_extension (g o f) x = (Gromov_extension g o Gromov_extension f) x" if H: "x  Gromov_boundary" for x
  proof -
    obtain u where u: "n. u n  range to_Gromov_completion" "u  x"
      using closure_sequential to_Gromov_completion_range_dense by blast
    have "(λn. Gromov_extension (g o f) (u n))  Gromov_extension (g o f) x"
      apply (rule continuous_within_tendsto_compose[OF _ _ u(2), of UNIV])
      using homeomorphism_on_continuous[OF Gromov_extension_isometry_homeomorphism[OF isometry_on_compose[OF assms(1) isometry_on_subset[OF assms(2)]]]] unfolding comp_def
      by (auto simp add: continuous_on_eq_continuous_within)
    then have A: "(λn. (Gromov_extension g) ((Gromov_extension f) (u n)))  Gromov_extension (g o f) x"
      unfolding In[OF u(1)] unfolding comp_def by auto

    have *: "(λn. (Gromov_extension f) (u n))  (Gromov_extension f) x"
      apply (rule continuous_within_tendsto_compose[OF _ _ u(2), of UNIV])
      using homeomorphism_on_continuous[OF Gromov_extension_isometry_homeomorphism[OF assms(1)]] unfolding comp_def
      by (auto simp add: continuous_on_eq_continuous_within)
    have "(λn. (Gromov_extension g) ((Gromov_extension f) (u n)))  Gromov_extension g ((Gromov_extension f) x)"
      apply (rule continuous_within_tendsto_compose[OF _ _ *, of UNIV])
      using homeomorphism_on_continuous[OF Gromov_extension_isometry_homeomorphism[OF assms(2)]] unfolding comp_def
      by (auto simp add: continuous_on_eq_continuous_within)
    then show ?thesis using LIMSEQ_unique A comp_def by auto
  qed
  ultimately have "Gromov_extension (g o f) x = (Gromov_extension g o Gromov_extension f) x" for x
    using not_in_Gromov_boundary by force
  then show ?thesis by auto
qed

text ‹We specialize the previous results to bijective isometries, as this is the setting where they
will be used most of the time.›

lemma Gromov_extension_isometry:
  assumes "isometry f"
  shows "homeomorphism_on UNIV (Gromov_extension f)"
        "continuous_on UNIV (Gromov_extension f)"
        "continuous (at x) (Gromov_extension f)"
using Gromov_extension_isometry_homeomorphism[OF isometryD(1)[OF assms]] homeomorphism_on_continuous apply auto
using ‹homeomorphism_on UNIV (Gromov_extension f) continuous_on_eq_continuous_within homeomorphism_on_continuous by blast

lemma Gromov_extension_isometry_composition:
  assumes "isometry f"
          "isometry g"
  shows "Gromov_extension (g o f) = Gromov_extension g o Gromov_extension f"
using Gromov_extension_isometry_on_composition[OF isometryD(1)[OF assms(1)] isometryD(1)[OF assms(2)]] by simp

lemma Gromov_extension_isometry_iterates:
  fixes f::"'a  ('a::Gromov_hyperbolic_space)"
  assumes "isometry f"
  shows "Gromov_extension (f^^n) = (Gromov_extension f)^^n"
apply (induction n) using Gromov_extension_isometry_composition[OF isometry_iterates[OF assms] assms] unfolding comp_def by auto

lemma Gromov_extension_isometry_inv:
  assumes "isometry f"
  shows "inv (Gromov_extension f) = Gromov_extension (inv f)"
        "bij (Gromov_extension f)"
proof -
  have *: "(inv f) o f = id"
    using isometry_inverse(2)[OF assms] by (simp add: bij_is_inj)
  have "Gromov_extension ((inv f) o f) = Gromov_extension (inv f) o Gromov_extension f"
    by (rule Gromov_extension_isometry_composition[OF assms isometry_inverse(1)[OF assms]])
  then have A: "Gromov_extension (inv f) o Gromov_extension f = id"
    unfolding * by auto
  have *: "f o (inv f) = id"
    using isometry_inverse(2)[OF assms] by (meson bij_is_surj surj_iff)
  have "Gromov_extension (f o (inv f)) = Gromov_extension f o Gromov_extension (inv f)"
    by (rule Gromov_extension_isometry_composition[OF isometry_inverse(1)[OF assms] assms])
  then have B: "Gromov_extension f o Gromov_extension (inv f) = id"
    unfolding * by auto
  show "bij (Gromov_extension f)"
    using A B unfolding bij_def apply auto
    by (metis inj_on_id inj_on_imageI2, metis B comp_apply id_def rangeI)
  show "inv (Gromov_extension f) = Gromov_extension (inv f)"
    using B ‹bij (Gromov_extension f) bij_is_inj inv_o_cancel left_right_inverse_eq by blast
qed

text ‹We will especially use fixed points on the boundary. We note that if a point is fixed by
(the Gromov extension of) a map, then it is fixed by (the Gromov extension of) its inverse.›

lemma Gromov_extension_inv_fixed_point:
  assumes "isometry (f::'a::Gromov_hyperbolic_space  'a)" "Gromov_extension f xi = xi"
  shows "Gromov_extension (inv f) xi = xi"
by (metis Gromov_extension_isometry_inv(1) Gromov_extension_isometry_inv(2) assms(1) assms(2) bij_betw_def inv_f_f)

text ‹The extended Gromov product is invariant under isometries. This follows readily from the
definition, but still the proof is not fully automatic, unfortunately.›

lemma Gromov_extension_preserves_extended_Gromov_product:
  assumes "isometry f"
  shows "extended_Gromov_product_at (f x) (Gromov_extension f xi) (Gromov_extension f eta) = extended_Gromov_product_at x xi eta"
proof -
  have "{liminf (λn. ereal (Gromov_product_at (f x) (u n) (v n))) |u v.
          (λn. to_Gromov_completion (u n))  Gromov_extension f xi  (λn. to_Gromov_completion (v n))  Gromov_extension f eta} =
        {liminf (λn. ereal (Gromov_product_at x (u n) (v n))) |u v.
          (λn. to_Gromov_completion (u n))  xi  (λn. to_Gromov_completion (v n))  eta}"
  proof (auto)
    fix u v assume H: "(λn. to_Gromov_completion (u n))  Gromov_extension f xi"
                      "(λn. to_Gromov_completion (v n))  Gromov_extension f eta"
    define u' where "u' = (λn. (inv f) (u n))"
    define v' where "v' = (λn. (inv f) (v n))"
    have "(λn. to_Gromov_completion (u' n))  Gromov_extension (inv f) (Gromov_extension f xi)"
      unfolding u'_def Gromov_extension_inside_space[symmetric]
      apply (rule iffD1[OF homeomorphism_on_compose[OF Gromov_extension_isometry_homeomorphism[OF isometryD(1)[OF isometry_inverse(1)[OF assms]]]]])
      using H(1) by auto
    moreover have "Gromov_extension (inv f) (Gromov_extension f xi) = xi"
      using Gromov_extension_isometry_composition[OF assms isometry_inverse(1)[OF assms], symmetric] unfolding comp_def
      using bij_is_inj[OF isometry_inverse(2)[OF assms]]
      by (simp add: ‹Gromov_extension (inv f)  Gromov_extension f = Gromov_extension (inv f  f) pointfree_idE)
    ultimately have U: "(λn. to_Gromov_completion (u' n))  xi" by simp
    have "(λn. to_Gromov_completion (v' n))  Gromov_extension (inv f) (Gromov_extension f eta)"
      unfolding v'_def Gromov_extension_inside_space[symmetric]
      apply (rule iffD1[OF homeomorphism_on_compose[OF Gromov_extension_isometry_homeomorphism[OF isometryD(1)[OF isometry_inverse(1)[OF assms]]]]])
      using H(2) by auto
    moreover have "Gromov_extension (inv f) (Gromov_extension f eta) = eta"
      using Gromov_extension_isometry_composition[OF assms isometry_inverse(1)[OF assms], symmetric] unfolding comp_def
      using bij_is_inj[OF isometry_inverse(2)[OF assms]]
      by (simp add: ‹Gromov_extension (inv f)  Gromov_extension f = Gromov_extension (inv f  f) pointfree_idE)
    ultimately have V: "(λn. to_Gromov_completion (v' n))  eta" by simp
    have uv: "u n = f (u' n)" "v n = f (v' n)" for n
      unfolding u'_def v'_def by (auto simp add: assms isometryD(3) surj_f_inv_f)
    have "Gromov_product_at (f x) (u n) (v n) = Gromov_product_at x (u' n) (v' n)" for n
      unfolding uv using assms by (simp add: Gromov_product_isometry isometry_def)
    then have "liminf (λn. ereal (Gromov_product_at (f x) (u n) (v n))) = liminf (λn. ereal (Gromov_product_at x (u' n) (v' n)))"
      by auto
    then show "u' v'.
              liminf (λn. ereal (Gromov_product_at (f x) (u n) (v n))) = liminf (λn. ereal (Gromov_product_at x (u' n) (v' n))) 
              (λn. to_Gromov_completion (u' n))  xi  (λn. to_Gromov_completion (v' n))  eta"
      using U V by blast
  next
    fix u v assume H: "(λn. to_Gromov_completion (u n))  xi"
                      "(λn. to_Gromov_completion (v n))  eta"
    define u' where "u' = (λn. f (u n))"
    define v' where "v' = (λn. f (v n))"
    have U: "(λn. to_Gromov_completion (u' n))  Gromov_extension f xi"
      unfolding u'_def Gromov_extension_inside_space[symmetric]
      apply (rule iffD1[OF homeomorphism_on_compose[OF Gromov_extension_isometry_homeomorphism[OF isometryD(1)[OF assms]]]])
      using H(1) by auto
    have V: "(λn. to_Gromov_completion (v' n))  Gromov_extension f eta"
      unfolding v'_def Gromov_extension_inside_space[symmetric]
      apply (rule iffD1[OF homeomorphism_on_compose[OF Gromov_extension_isometry_homeomorphism[OF isometryD(1)[OF assms]]]])
      using H(2) by auto
    have "Gromov_product_at (f x) (u' n) (v' n) = Gromov_product_at x (u n) (v n)" for n
      unfolding u'_def v'_def using assms by (simp add: Gromov_product_isometry isometry_def)
    then have "liminf (λn. ereal (Gromov_product_at x (u n) (v n))) = liminf (λn. ereal (Gromov_product_at (f x) (u' n) (v' n)))"
      by auto
    then show "u' v'.
              liminf (λn. ereal (Gromov_product_at x (u n) (v n))) = liminf (λn. ereal (Gromov_product_at (f x) (u' n) (v' n))) 
              (λn. to_Gromov_completion (u' n))  Gromov_extension f xi  (λn. to_Gromov_completion (v' n))  Gromov_extension f eta"
      using U V by auto
  qed
  then show ?thesis
    unfolding extended_Gromov_product_at_topological by auto
qed

end (*of theory Boundary_Extension*)

Theory Busemann_Function

(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
    License: BSD
*)

section ‹Busemann functions›

theory Busemann_Function
  imports Boundary_Extension Ergodic_Theory.Fekete
begin

text ‹The Busemann function $B_\xi(x,y)$ measures the difference $d(\xi, x) - d(\xi, y)$, where $\xi$
is a point at infinity and $x$ and $y$ are inside a Gromov hyperbolic space. This is not well defined
in this way, as we are subtracting two infinities, but one can make sense of this difference by
considering the behavior along a sequence tending to $\xi$. The limit may depend on the sequence, but
as usual in Gromov hyperbolic spaces it only depends on the sequence up to a uniform constant. Thus,
we may define the Busemann function using for instance the supremum of the limsup over all possible
sequences -- other choices would give rise to equivalent definitions, up to some multiple of
$\delta$.›

definition Busemann_function_at::"('a::Gromov_hyperbolic_space) Gromov_completion  'a  'a  real"
  where "Busemann_function_at xi x y = real_of_ereal (
    Sup {limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. (λn. to_Gromov_completion (u n))  xi})"

text ‹Since limsups are only defined for complete orders currently, the definition goes through
ereals, and we go back to reals afterwards. However, there is no real difficulty here, as eveything
is bounded above and below (by $d(x,y)$ and $-d(x,y)$ respectively.›

lemma Busemann_function_ereal:
  "ereal(Busemann_function_at xi x y) = Sup {limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. (λn. to_Gromov_completion (u n))  xi}"
proof -
  have A: "Sup {limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. (λn. to_Gromov_completion (u n))  xi}  dist x y"
    by (rule Sup_least, auto intro!: Limsup_bounded always_eventually mono_intros simp add: algebra_simps)
  have B: "Sup {limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. (λn. to_Gromov_completion (u n))  xi}  -dist x y"
  proof -
    obtain u where *: "(λn. to_Gromov_completion (u n))  xi"
      using rep_Gromov_completion_limit[of xi] by blast
    have "ereal(-dist x y)  limsup (λn. ereal(dist x (u n) - dist y (u n)))"
      by (rule le_Limsup, auto intro!: always_eventually mono_intros simp add: algebra_simps)
    also have "...  Sup {limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. (λn. to_Gromov_completion (u n))  xi}"
      apply (rule Sup_upper) using * by auto
    finally show ?thesis by simp
  qed
  show ?thesis
    unfolding Busemann_function_at_def apply (rule ereal_real') using A B by auto
qed

text ‹If $\xi$ is not at infinity, then the Busemann function is simply the difference of the
distances.›

lemma Busemann_function_inner:
  "Busemann_function_at (to_Gromov_completion z) x y = dist x z - dist y z"
proof -
  have L: "limsup (λn. ereal(dist x (u n) - dist y (u n))) = dist x z - dist y z" if "u  z" for u
    by (rule lim_imp_Limsup, simp, intro tendsto_intros that)
  have "Sup {limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. u  z}
      = dist x z - dist y z"
  proof -
    obtain u where u: "u  z"
      by auto
    show ?thesis
      apply (rule order.antisym)
      apply (subst Sup_le_iff) using L apply auto[1]
      apply (subst L[OF u, symmetric]) apply (rule Sup_upper) using u by auto
  qed
  then have "ereal (Busemann_function_at (to_Gromov_completion z) x y) = dist x z - dist y z"
    unfolding Busemann_function_ereal by auto
  then show ?thesis by auto
qed

text ‹The Busemann function measured at the same points vanishes.›

lemma Busemann_function_xx [simp]:
  "Busemann_function_at xi x x = 0"
proof -
  have *: "{limsup (λn. ereal(dist x (u n) - dist x (u n))) |u. (λn. to_Gromov_completion (u n))  xi} = {0}"
    by (auto simp add: zero_ereal_def[symmetric] intro!: lim_imp_Limsup rep_Gromov_completion_limit[of xi])
  have "ereal (Busemann_function_at xi x x) = ereal 0"
    unfolding Busemann_function_ereal * by auto
  then show ?thesis
    by auto
qed

text ‹Perturbing the points gives rise to a variation of the Busemann function bounded by the
size of the variations. This is obvious for inner Busemann functions, and everything passes
readily to the limit.›

lemma Busemann_function_mono [mono_intros]:
  "Busemann_function_at xi x y  Busemann_function_at xi x' y' + dist x x' + dist y y'"
proof -
  have A: "limsup (λn. ereal (dist x (u n) - dist y (u n)))
           ereal(Busemann_function_at xi x' y') + ereal (dist x x' + dist y y')"
    if "(λn. to_Gromov_completion (u n))  xi" for u
  proof -
    have *: "dist x z + dist y' z  dist x x' + (dist y y' + (dist x' z + dist y z))" for z
      using add_mono[OF dist_triangle[of x z x'] dist_triangle[of y' z y]] dist_commute[of y y'] by auto
    have "limsup (λn. ereal (dist x (u n) - dist y (u n))) + (- ereal (dist x x' + dist y y'))
      = limsup (λn. ereal (dist x (u n) - dist y (u n)) + (- ereal (dist x x' + dist y y')))"
      by (rule Limsup_add_ereal_right[symmetric], auto)
    also have "...  limsup (λn. ereal (dist x' (u n) - dist y' (u n)))"
      by (auto intro!: Limsup_mono always_eventually simp: algebra_simps *)
    also have "...  Sup {limsup (λn. ereal (dist x' (u n) - dist y' (u n))) |u. (λn. to_Gromov_completion (u n))  xi}"
      apply (rule Sup_upper) using that by auto
    finally have "limsup (λn. ereal (dist x (u n) - dist y (u n))) + (- ereal (dist x x' + dist y y'))
           ereal(Busemann_function_at xi x' y')"
      unfolding Busemann_function_ereal by auto
    then show ?thesis
      unfolding minus_ereal_def[symmetric] by (subst ereal_minus_le[symmetric], auto)
  qed
  have "ereal (Busemann_function_at xi x y)  ereal(Busemann_function_at xi x' y') + dist x x' + dist y y'"
    unfolding Busemann_function_ereal[of xi x y] using A by (auto intro!: Sup_least simp: algebra_simps)
  then show ?thesis by simp
qed

text ‹In particular, it follows that the Busemann function $B_\xi(x,y)$ is bounded in absolute value
by $d(x,y)$.›

lemma Busemann_function_le_dist [mono_intros]:
  "abs(Busemann_function_at xi x y)  dist x y"
using Busemann_function_mono[of xi x y y y] Busemann_function_mono[of xi x x x y] by auto

lemma Busemann_function_Lipschitz [mono_intros]:
  "abs(Busemann_function_at xi x y - Busemann_function_at xi x' y')  dist x x' + dist y y'"
using Busemann_function_mono[of xi x y x' y'] Busemann_function_mono[of xi x' y' x y] by (simp add: dist_commute)

text ‹By the very definition of the Busemann function, the difference of distance functions is
bounded above by the Busemann function when one converges to $\xi$.›

lemma Busemann_function_limsup:
  assumes "(λn. to_Gromov_completion (u n))  xi"
  shows "limsup (λn. dist x (u n) - dist y (u n))  Busemann_function_at xi x y"
unfolding Busemann_function_ereal apply (rule Sup_upper) using assms by auto

text ‹There is also a corresponding bound below, but with the loss of a constant. This follows
from the hyperbolicity of the space and a simple computation.›

lemma Busemann_function_liminf:
  assumes "(λn. to_Gromov_completion (u n))  xi"
  shows "Busemann_function_at xi x y  liminf (λn. dist (x::'a::Gromov_hyperbolic_space) (u n) - dist y (u n)) + 2 * deltaG(TYPE('a))"
proof (cases xi)
  case (to_Gromov_completion z)
  have *: "liminf (λn. dist x (u n) - dist y (u n)) = dist x z - dist y z"
    apply (rule lim_imp_Liminf, simp, intro tendsto_intros)
    using assms unfolding to_Gromov_completion by auto
  show ?thesis
    unfolding to_Gromov_completion plus_ereal.simps(1)[symmetric] Busemann_function_inner * by auto
next
  case boundary
  have I: "limsup (λn. ereal(dist x (v n) - dist y (v n)))  liminf (λn. ereal(dist x (u n) - dist y (u n))) + 2 * deltaG(TYPE('a))"
    if v: "(λn. to_Gromov_completion (v n))  xi" for v
  proof -
    obtain N where N: "m n. m  N  n  N  Gromov_product_at x (u m) (v n)  dist x y"
      using same_limit_imp_Gromov_product_tendsto_infinity[OF boundary assms v] by blast
    have A: "dist x (v n) - dist y (v n) - 2 * deltaG(TYPE('a))  dist x (u m) - dist y (u m)" if "m  N" "n  N" for m n
    proof -
      have "Gromov_product_at x (v n) y  dist x y"
        by (intro mono_intros)
      then have "min (Gromov_product_at x (u m) (v n)) (Gromov_product_at x (v n) y) = Gromov_product_at x (v n) y"
        using N[OF m  N n  N] by linarith
      moreover have "Gromov_product_at x (u m) y  min (Gromov_product_at x (u m) (v n)) (Gromov_product_at x (v n) y) - deltaG(TYPE('a))"
        by (intro mono_intros)
      ultimately have "Gromov_product_at x (u m) y  Gromov_product_at x (v n) y - deltaG(TYPE('a))"
        by auto
      then show ?thesis
        unfolding Gromov_product_at_def by (auto simp add: algebra_simps divide_simps dist_commute)
    qed
    have B: "dist x (v n) - dist y (v n) - 2 * deltaG(TYPE('a))  liminf (λm. dist x (u m) - dist y (u m))" if "n  N" for n
      apply (rule Liminf_bounded) using A[OF _ that] unfolding eventually_sequentially by auto
    have C: "dist x (v n) - dist y (v n)  liminf (λm. dist x (u m) - dist y (u m)) + 2 * deltaG(TYPE('a))" if "n  N" for n
      using B[OF that] by (subst ereal_minus_le[symmetric], auto)
    show ?thesis
      apply (rule Limsup_bounded) unfolding eventually_sequentially apply (rule exI[of _ N]) using C by auto
  qed
  show ?thesis
    unfolding Busemann_function_ereal apply (rule Sup_least) using I by auto
qed

text ‹To avoid formulating things in terms of liminf and limsup on ereal, the following formulation
of the two previous lemmas is useful.›

lemma Busemann_function_inside_approx:
  assumes "e > (0::real)" "(λn. to_Gromov_completion (t n::'a::Gromov_hyperbolic_space))  xi"
  shows "eventually (λn. Busemann_function_at (to_Gromov_completion (t n)) x y  Busemann_function_at xi x y + e
               Busemann_function_at (to_Gromov_completion (t n)) x y  Busemann_function_at xi x y - 2 * deltaG(TYPE('a)) - e) sequentially"
proof -
  have A: "eventually (λn. Busemann_function_at (to_Gromov_completion (t n)) x y < Busemann_function_at xi x y + ereal e) sequentially"
    apply (rule Limsup_lessD)
    unfolding Busemann_function_inner using le_less_trans[OF Busemann_function_limsup[OF assms(2)]] e > 0 by auto
  have B: "eventually (λn. Busemann_function_at (to_Gromov_completion (t n)) x y > Busemann_function_at xi x y -2 * deltaG(TYPE('a)) - ereal e) sequentially"
    apply (rule less_LiminfD)
    unfolding Busemann_function_inner using less_le_trans[OF _ Busemann_function_liminf[OF assms(2)], of "ereal(Busemann_function_at xi x y) - ereal e" x y] e > 0 apply auto
    apply (unfold ereal_minus(1)[symmetric], subst ereal_minus_less_iff, simp)+
    unfolding ereal_minus(1)[symmetric] by (simp only: ereal_minus_less_iff, auto simp add: algebra_simps)
  show ?thesis
    by (rule eventually_mono[OF eventually_conj[OF A B]], auto)
qed

text ‹The Busemann function is essentially a morphism, i.e., it should satisfy $B_\xi(x,z) =
B_\xi(x,y) + B_\xi(y,z)$, as it is defined as a difference of distances. This is not exactly
the case as there is a choice in the definition, but it is the case up to a uniform constant,
as we show in the next few lemmas. One says that it is a~\emph{quasi-morphism}.›

lemma Busemann_function_triangle [mono_intros]:
  "Busemann_function_at xi x z  Busemann_function_at xi x y + Busemann_function_at xi y z"
proof -
  have "limsup (λn. dist x (u n) - dist z (u n))  Busemann_function_at xi x y + Busemann_function_at xi y z"
    if "(λn. to_Gromov_completion (u n))  xi" for u
  proof -
    have "limsup (λn. dist x (u n) - dist z (u n)) = limsup (λn. ereal (dist x (u n) - dist y (u n)) + (dist y (u n) - dist z (u n)))"
      by auto
    also have "...  limsup (λn. dist x (u n) - dist y (u n)) + limsup (λn. dist y (u n) - dist z (u n))"
      by (rule ereal_limsup_add_mono)
    also have "...  ereal(Busemann_function_at xi x y) + Busemann_function_at xi y z"
      unfolding Busemann_function_ereal using that by (auto intro!: add_mono Sup_upper)
    finally show ?thesis by auto
  qed
  then have "ereal (Busemann_function_at xi x z)  Busemann_function_at xi x y + Busemann_function_at xi y z"
    unfolding Busemann_function_ereal[of xi x z] by (auto intro!: Sup_least)
  then show ?thesis
    by auto
qed

lemma Busemann_function_xy_yx [mono_intros]:
  "Busemann_function_at xi x y + Busemann_function_at xi y (x::'a::Gromov_hyperbolic_space)  2 * deltaG(TYPE('a))"
proof -
  have *: "- liminf (λn. ereal (dist y (u n) - dist x (u n)))  ereal (2 * deltaG TYPE('a) - Busemann_function_at xi y x)"
    if "(λn. to_Gromov_completion (u n))  xi" for u
    using Busemann_function_liminf[of _ xi y x, OF that] ereal_minus_le_minus_plus unfolding ereal_minus(1)[symmetric]
    by fastforce

  have "ereal (Busemann_function_at xi x y) = Sup {limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. (λn. to_Gromov_completion (u n))  xi}"
    unfolding Busemann_function_ereal by auto
  also have "... = Sup {limsup (λn. - ereal(dist y (u n) - dist x (u n))) |u. (λn. to_Gromov_completion (u n))  xi}"
    by auto
  also have "... = Sup {- liminf (λn. ereal(dist y (u n) - dist x (u n))) |u. (λn. to_Gromov_completion (u n))  xi}"
    unfolding ereal_Limsup_uminus by auto
  also have "...  2 * deltaG(TYPE('a)) - ereal(Busemann_function_at xi y x)"
    by (auto intro!: Sup_least *)
  finally show ?thesis
    by simp
qed

theorem Busemann_function_quasi_morphism [mono_intros]:
  "¦Busemann_function_at xi x y + Busemann_function_at xi y z - Busemann_function_at xi x (z::'a::Gromov_hyperbolic_space)¦  2 * deltaG(TYPE('a))"
using Busemann_function_triangle[of xi x z y] Busemann_function_triangle[of xi x y z] Busemann_function_xy_yx[of xi y z] by auto

text ‹The extended Gromov product can be bounded from below by the Busemann function.›

lemma Busemann_function_le_Gromov_product:
  "- Busemann_function_at xi y x/2  extended_Gromov_product_at x xi (to_Gromov_completion y)"
proof -
  have A: "-ereal(Busemann_function_at xi y x/2)  liminf (λn. Gromov_product_at x (u n) y)"
    if "(λn. to_Gromov_completion (u n))  xi" for u
  proof -
    have *: "limsup (λn. - ereal (Gromov_product_at x (u n) y) * 2)  limsup (λn. ereal (dist y (u n) - dist x (u n)))"
      by (auto intro!: Limsup_mono always_eventually simp: algebra_simps Gromov_product_at_def divide_simps dist_commute)
    also have "...  ereal(Busemann_function_at xi y x)"
      unfolding Busemann_function_ereal using that by (auto intro!: Sup_upper)
    finally have "-ereal(Busemann_function_at xi y x)  liminf (λn. Gromov_product_at x (u n) y) * ereal 2"
      apply (subst ereal_uminus_le_reorder, subst ereal_mult_minus_left[symmetric], subst ereal_Limsup_uminus[symmetric])
      by (subst limsup_ereal_mult_right[symmetric], auto)
    moreover have "-ereal(z/2)  t" if "-ereal z  t * ereal 2" for z t
    proof -
      have *: "-ereal(z/2) = -ereal z / ereal 2"
        unfolding ereal_divide by auto
      have "0 < ereal 2"
        by auto
      then show ?thesis unfolding * using that
        by (metis (no_types) PInfty_neq_ereal(2) ereal_divide_le_posI ereal_uminus_eq_iff mult.commute that)
    qed
    ultimately show ?thesis by auto
  qed
  show ?thesis
  unfolding extended_Gromov_product_at_def proof (rule Inf_greatest, auto)
    fix u v assume uv: "xi = abs_Gromov_completion u" "abs_Gromov_completion v = to_Gromov_completion y" "Gromov_completion_rel u u" "Gromov_completion_rel v v"
    then have L: "(λn. to_Gromov_completion (u n))  xi"
      using abs_Gromov_completion_limit by auto
    have *: "v n = y" for n
      using uv by (metis (mono_tags, hide_lams) Gromov_completion_rel_def Quotient3_Gromov_completion Quotient3_rep_abs abs_Gromov_completion_in_Gromov_boundary not_in_Gromov_boundary' rep_Gromov_completion_to_Gromov_completion)
    show "ereal (- (Busemann_function_at (abs_Gromov_completion u) y x / 2))  liminf (λn. ereal (Gromov_product_at x (u n) (v n)))"
      unfolding uv(1)[symmetric] * using A[OF L] by simp
  qed
qed

text ‹It follows that, if the Busemann function tends to minus infinity, i.e., the distance to
$\xi$ becomes smaller and smaller in a suitable sense, then the sequence is converging to $\xi$.
This is only an implication: one can have sequences tending to $\xi$ for which the Busemann function
does not tend to $-\infty$. This is in fact a stronger notion of convergence, sometimes called
radial convergence.›

proposition Busemann_function_minus_infinity_imp_convergent:
  assumes "((λn. Busemann_function_at xi (u n) x)  -) F"
  shows "((λn. to_Gromov_completion (u n))  xi) F"
proof (cases "trivial_limit F")
  case True
  then show ?thesis by auto
next
  case False
  have "xi  Gromov_boundary"
  proof (cases xi)
    case (to_Gromov_completion z)
    then have "ereal(Busemann_function_at xi (u n) x)  - dist x z" for n
      unfolding to_Gromov_completion Busemann_function_inner by auto
    then have "-  -dist x z"
      using tendsto_lowerbound[OF assms always_eventually False] by metis
    then have False
      by auto
    then show ?thesis by auto
  qed
  have "((λn. - ereal (Busemann_function_at xi (u n) x) / 2)  (- (-)/2)) F"
    apply (intro tendsto_intros) using assms by auto
  then have *: "((λn. - ereal (Busemann_function_at xi (u n) x) / 2)  ) F"
    by auto
  have **: "((λn. extended_Gromov_product_at x xi (to_Gromov_completion (u n)))  ) F"
    apply (rule tendsto_sandwich[of "λn. - ereal (Busemann_function_at xi (u n) x) / 2" _ _ "λn. ", OF always_eventually always_eventually])
    using Busemann_function_le_Gromov_product[of xi _ x] * by auto
  show ?thesis
    using extended_Gromov_product_tendsto_PInf_a_b[OF **, of basepoint]
    by (auto simp add: Gromov_completion_boundary_limit[OF xi  Gromov_boundary›] extended_Gromov_product_at_commute)
qed

text ‹Busemann functions are invariant under isometries. This is trivial as everything is defined
in terms of the distance, but the definition in terms of supremum and limsups makes the proof
tedious.›

lemma Busemann_function_isometry:
  assumes "isometry f"
  shows "Busemann_function_at (Gromov_extension f xi) (f x) (f y) = Busemann_function_at xi x y"
proof -
  have "{limsup (λn. ereal(dist x (u n) - dist y (u n))) |u. (λn. to_Gromov_completion (u n))  xi}
        = {limsup (λn. ereal(dist (f x) (v n) - dist (f y) (v n))) |v. (λn. to_Gromov_completion (v n))  Gromov_extension f xi}"
  proof (auto)
    fix u assume u: "(λn. to_Gromov_completion (u n))  xi"
    define v where "v = f o u"
    have "(λn. to_Gromov_completion (v n))  Gromov_extension f xi"
      unfolding v_def comp_def Gromov_extension_inside_space[symmetric] using u Gromov_extension_isometry(2)[OF ‹isometry f]
      by (metis continuous_on filterlim_compose iso_tuple_UNIV_I tendsto_at_iff_tendsto_nhds)
    moreover have "limsup (λn. ereal (dist x (u n) - dist y (u n))) = limsup (λn. ereal (dist (f x) (v n) - dist (f y) (v n)))"
      unfolding v_def comp_def isometryD(2)[OF ‹isometry f] by simp
    ultimately show "v. limsup (λn. ereal (dist x (u n) - dist y (u n))) = limsup (λn. ereal (dist (f x) (v n) - dist (f y) (v n))) 
              (λn. to_Gromov_completion (v n))  Gromov_extension f xi"
      by blast
  next
    fix v assume v: "(λn. to_Gromov_completion (v n))  Gromov_extension f xi"
    define u where "u = (inv f) o v"
    have "isometry (inv f)"
      using isometry_inverse(1)[OF ‹isometry f] by simp
    have *: "inv f (f z) = z" for z
      using isometry_inverse(2)[OF ‹isometry f] by (simp add: bij_betw_def)
    have **: "(Gromov_extension (inv f) (Gromov_extension f xi)) = xi"
      using Gromov_extension_isometry_composition[OF ‹isometry f ‹isometry (inv f)]
      unfolding comp_def using isometry_inverse(2)[OF ‹isometry f] by (auto simp: *, metis)
    have "(λn. to_Gromov_completion (u n))  Gromov_extension (inv f) (Gromov_extension f xi)"
      unfolding u_def comp_def Gromov_extension_inside_space[symmetric] using v Gromov_extension_isometry(2)[OF ‹isometry (inv f)]
      by (metis continuous_on filterlim_compose iso_tuple_UNIV_I tendsto_at_iff_tendsto_nhds)
    then have "(λn. to_Gromov_completion (u n))  xi"
      using ** by auto
    moreover have "limsup (λn. ereal (dist ((inv f) (f x)) (u n) - dist ((inv f) (f y)) (u n))) = limsup (λn. ereal (dist (f x) (v n) - dist (f y) (v n)))"
      unfolding u_def comp_def isometryD(2)[OF ‹isometry (inv f)] by simp
    ultimately show "u. limsup (λn. ereal (dist (f x) (v n) - dist (f y) (v n))) = limsup (λn. ereal (dist x (u n) - dist y (u n)))  (λn. to_Gromov_completion (u n))  xi"
      by (simp add: *, force)
  qed
  then have "ereal (Busemann_function_at xi x y) = ereal (Busemann_function_at (Gromov_extension f xi) (f x) (f y))"
    unfolding Busemann_function_ereal by auto
  then show ?thesis by auto
qed

lemma dist_le_max_Busemann_functions [mono_intros]:
  assumes "xi  eta"
  shows "dist x (y::'a::Gromov_hyperbolic_space)  2 * real_of_ereal (extended_Gromov_product_at y xi eta)
            + max (Busemann_function_at xi x y) (Busemann_function_at eta x y) + 2 * deltaG(TYPE('a))"
proof -
  have A: "ereal(dist x y - 2 * deltaG(TYPE('a)) - max (Busemann_function_at xi x y) (Busemann_function_at eta x y)) / ereal 2 
                    liminf (λn. ereal(Gromov_product_at y (u n) (v n)))"
    if uv: "abs_Gromov_completion u = xi" "abs_Gromov_completion v = eta" "Gromov_completion_rel u u" "Gromov_completion_rel v v" for u v
  proof -
    have C: "(λn. to_Gromov_completion (u n))  xi" "(λn. to_Gromov_completion (v n))  eta"
      using uv abs_Gromov_completion_limit by auto
    have "ereal(dist x y)  ereal(2 * Gromov_product_at y (u n) (v n)) + 2 * deltaG(TYPE('a)) + max (ereal(dist x (u n) - dist y (u n))) (ereal(dist x (v n) - dist y (v n)))" for n
    proof -
      have "min (Gromov_product_at y (u n) x) (Gromov_product_at y x (v n))  Gromov_product_at y (u n) (v n) + deltaG(TYPE('a))"
        by (intro mono_intros)
      then consider "Gromov_product_at y (u n) x  Gromov_product_at y (u n) (v n) + deltaG(TYPE('a))"|"Gromov_product_at y x (v n)  Gromov_product_at y (u n) (v n) + deltaG(TYPE('a))"
        by linarith
      then have "dist x y  2 * Gromov_product_at y (u n) (v n) + 2 * deltaG(TYPE('a)) + max (dist x (u n) - dist y (u n)) (dist x (v n) - dist y (v n))"
        unfolding Gromov_product_at_def[of _ x] Gromov_product_at_def[of _ _ x] apply (cases)
        by (auto simp add: algebra_simps divide_simps dist_commute)
      then show ?thesis
        unfolding ereal_max[symmetric] plus_ereal.simps(1) by auto
    qed
    then have "ereal (dist x y)  liminf (λn. ereal(2 * Gromov_product_at y (u n) (v n)) + 2 * deltaG(TYPE('a)) + max (ereal(dist x (u n) - dist y (u n))) (ereal(dist x (v n) - dist y (v n))))"
      by (intro Liminf_bounded always_eventually, auto)
    also have "...  liminf (λn. ereal(2 * Gromov_product_at y (u n) (v n)) + 2 * deltaG(TYPE('a))) + limsup (λn. max (ereal(dist x (u n) - dist y (u n))) (ereal(dist x (v n) - dist y (v n))))"
      by (rule ereal_liminf_limsup_add)
    also have "... = liminf (λn. ereal(2 * Gromov_product_at y (u n) (v n))) + 2 * deltaG(TYPE('a)) + max (limsup (λn. ereal(dist x (u n) - dist y (u n)))) (limsup (λn. ereal(dist x (v n) - dist y (v n))))"
      apply (subst Liminf_add_ereal_right) by (auto simp add: Limsup_max_eq_max_Limsup)
    also have "...  liminf (λn. ereal(2 * Gromov_product_at y (u n) (v n))) + 2 * deltaG(TYPE('a)) + max (ereal(Busemann_function_at xi x y)) (Busemann_function_at eta x y)"
      unfolding Busemann_function_ereal apply (intro mono_intros Sup_upper) using C by auto
    finally have "ereal(dist x y) - ereal(2 * deltaG(TYPE('a)) + max (Busemann_function_at xi x y) (Busemann_function_at eta x y)) 
                    liminf (λn. ereal(2 * Gromov_product_at y (u n) (v n)))"
      unfolding ereal_max[symmetric] add.assoc plus_ereal.simps(1) by (subst ereal_minus_le, auto)
    then have "ereal(dist x y - 2 * deltaG(TYPE('a)) - max (Busemann_function_at xi x y) (Busemann_function_at eta x y)) 
                    liminf (λn. ereal(2 * Gromov_product_at y (u n) (v n)))"
      unfolding ereal_minus(1) by (auto simp add: algebra_simps)
    also have "... = ereal 2 * liminf (λn. ereal(Gromov_product_at y (u n) (v n)))"
      unfolding times_ereal.simps(1)[symmetric] by (subst Liminf_ereal_mult_left, auto)
    finally show ?thesis
      by (subst ereal_divide_le_pos, auto)
  qed
  have "ereal(dist x y - 2 * deltaG(TYPE('a)) - max (Busemann_function_at xi x y) (Busemann_function_at eta x y)) / ereal 2 
                    extended_Gromov_product_at y xi eta"
    unfolding extended_Gromov_product_at_def apply (rule Inf_greatest) using A by auto
  also have "... = ereal(real_of_ereal(extended_Gromov_product_at y xi eta))"
    using assms by simp
  finally show ?thesis
    by simp
qed

lemma dist_minus_Busemann_max_ineq:
  "dist (x::'a::Gromov_hyperbolic_space) z - Busemann_function_at xi z x  max (dist x y - Busemann_function_at xi y x) (dist y z - Busemann_function_at xi z y - 2 * Busemann_function_at xi y x) + 8 * deltaG(TYPE('a))"
proof -
  have I: "dist x z - Busemann_function_at (to_Gromov_completion t) z x  max (dist x y - Busemann_function_at (to_Gromov_completion t) y x)
                      (dist y z - Busemann_function_at (to_Gromov_completion t) z y - 2 * Busemann_function_at (to_Gromov_completion t) y x)
                        + 2 * deltaG(TYPE('a))" for t
  proof -
    have "2 * dist x t + - max (dist x y - Busemann_function_at (to_Gromov_completion t) y x) (dist y z - Busemann_function_at (to_Gromov_completion t) z y - 2 * Busemann_function_at (to_Gromov_completion t) y x)
          = min (2 * dist x t - (dist x y - Busemann_function_at (to_Gromov_completion t) y x)) (2 * dist x t - (dist y z - Busemann_function_at (to_Gromov_completion t) z y - 2 * Busemann_function_at (to_Gromov_completion t) y x))"
      unfolding minus_max_eq_min min_add_distrib_right by auto
    also have "... = min (2 * Gromov_product_at t x y) (2 * Gromov_product_at t y z)"
      apply (rule cong[of "min _" "min _"], rule cong [of min min])
      unfolding Gromov_product_at_def Busemann_function_inner by (auto simp add: algebra_simps dist_commute divide_simps)
    also have "... = 2 * (min (Gromov_product_at t x y) (Gromov_product_at t y z))"
      by auto
    also have "...  2 * (Gromov_product_at t x z + deltaG(TYPE('a)))"
      by (intro mono_intros, auto)
    also have "... = 2 * dist x t - (dist x z - Busemann_function_at (to_Gromov_completion t) z x) + 2 * deltaG(TYPE('a))"
      unfolding Gromov_product_at_def Busemann_function_inner by (auto simp add: algebra_simps dist_commute divide_simps)
    finally show ?thesis
      by auto
  qed
  have "dist x z - Busemann_function_at xi z x  max (dist x y - Busemann_function_at xi y x) (dist y z - Busemann_function_at xi z y - 2 * Busemann_function_at xi y x) + 8 * deltaG(TYPE('a)) + d"
    if "d > 0" for d
  proof -
    define e where "e = d/4"
    have "e > 0" unfolding e_def using that by auto
    obtain t where t: "(λn. to_Gromov_completion (t n))  xi"
      using rep_Gromov_completion_limit by auto
    have A: "eventually (λn. Busemann_function_at xi y x  Busemann_function_at (to_Gromov_completion (t n)) y x + 2 * deltaG(TYPE('a)) + e) sequentially"
      by (rule eventually_mono[OF Busemann_function_inside_approx[OF e > 0 t, of y x]], auto)
    have B: "eventually (λn. Busemann_function_at xi z y  Busemann_function_at (to_Gromov_completion (t n)) z y + 2 * deltaG(TYPE('a)) + e) sequentially"
      by (rule eventually_mono[OF Busemann_function_inside_approx[OF e > 0 t, of z y]], auto)
    have C: "eventually (λn. Busemann_function_at xi z x  Busemann_function_at (to_Gromov_completion (t n)) z x - e) sequentially"
      by (rule eventually_mono[OF Busemann_function_inside_approx[OF e > 0 t, of z x]], auto)
    obtain n where H: "Busemann_function_at xi y x  Busemann_function_at (to_Gromov_completion (t n)) y x + 2 * deltaG(TYPE('a)) + e"
                      "Busemann_function_at xi z y  Busemann_function_at (to_Gromov_completion (t n)) z y + 2 * deltaG(TYPE('a)) + e"
                      "Busemann_function_at xi z x  Busemann_function_at (to_Gromov_completion (t n)) z x - e"
      using eventually_conj[OF A eventually_conj[OF B C]] eventually_sequentially by auto
    have "dist x z - Busemann_function_at xi z x - e  dist x z - Busemann_function_at (to_Gromov_completion (t n)) z x"
      using H by auto
    also have "...  max (dist x y - Busemann_function_at (to_Gromov_completion (t n)) y x)
                      (dist y z - Busemann_function_at (to_Gromov_completion (t n)) z y - 2 * Busemann_function_at (to_Gromov_completion (t n)) y x)
                        + 2 * deltaG(TYPE('a))"
      using I by auto
    also have "...  max (dist x y - (Busemann_function_at xi y x - 2 * deltaG(TYPE('a)) - e))
                      (dist y z - (Busemann_function_at xi z y - 2 * deltaG(TYPE('a)) - e) - 2 * (Busemann_function_at xi y x - 2 * deltaG(TYPE('a)) - e))
                        + 2 * deltaG(TYPE('a))"
      apply (intro mono_intros) using H by auto
    also have "...  max (dist x y - Busemann_function_at xi y x + 6 * deltaG(TYPE('a)) + 3 * e)
                      (dist y z - Busemann_function_at xi z y - 2 * Busemann_function_at xi y x + 6 * deltaG(TYPE('a)) + 3 * e)
                        + 2 * deltaG(TYPE('a))"
      apply (intro add_mono max.mono) using e > 0 by auto
    also have "... = max (dist x y - Busemann_function_at xi y x) (dist y z - Busemann_function_at xi z y - 2 * Busemann_function_at xi y x) + 8 * deltaG(TYPE('a)) + 3 * e"
      by auto
    finally show ?thesis unfolding e_def by auto
  qed
  then show ?thesis by (rule field_le_epsilon)
qed

end (*of theory Busemann_Function*)

Theory Isometries_Classification

(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
    License: BSD
*)

section ‹Classification of isometries on a Gromov hyperbolic space›

theory Isometries_Classification
  imports Gromov_Boundary Busemann_Function
begin

text ‹Isometries of Gromov hyperbolic spaces are of three types:
\begin{itemize}
\item Elliptic ones, for which orbits are bounded.
\item Parabolic ones, which are not elliptic and have exactly one fixed point
at infinity.
\item Loxodromic ones, which are not elliptic and have exactly two fixed points
at infinity.
\end{itemize}
In this file, we show that all isometries are indeed of this form, and give
further properties for each type.

For the definition, we use another characterization in terms of stable translation length: for
isometries which are not elliptic, then they are parabolic if the stable translation length is $0$,
loxodromic if it is positive. This gives a very efficient definition, and it is clear from this
definition that the three categories of isometries are disjoint. All the work is then to go from
this general definition to the dynamical properties in terms of fixed points on the boundary.
›


subsection ‹The translation length›

text ‹The translation length is the minimal translation distance of an isometry. The stable
translation length is the limit of the translation length of $f^n$ divided by $n$.›

definition translation_length::"(('a::metric_space)  'a)  real"
  where "translation_length f = Inf {dist x (f x)|x. True}"

lemma translation_length_nonneg [simp, mono_intros]:
  "translation_length f  0"
unfolding translation_length_def by (rule cInf_greatest, auto)

lemma translation_length_le [mono_intros]:
  "translation_length f  dist x (f x)"
unfolding translation_length_def apply (rule cInf_lower) by (auto intro: bdd_belowI[of _ 0])

definition stable_translation_length::"(('a::metric_space)  'a)  real"
  where "stable_translation_length f = Inf {translation_length (f^^n)/n |n. n > 0}"

lemma stable_translation_length_nonneg [simp]:
  "stable_translation_length f  0"
unfolding stable_translation_length_def by (rule cInf_greatest, auto)

lemma stable_translation_length_le_translation_length [mono_intros]:
  "n * stable_translation_length f  translation_length (f^^n)"
proof -
  have *: "stable_translation_length f  translation_length (f^^n)/n" if "n > 0" for n
    unfolding stable_translation_length_def apply (rule cInf_lower) using that by (auto intro: bdd_belowI[of _ 0])
  show ?thesis
    apply (cases "n = 0") using * by (auto simp add: divide_simps algebra_simps)
qed

lemma semicontraction_iterates:
  fixes f::"('a::metric_space)  'a"
  assumes "1-lipschitz_on UNIV f"
  shows "1-lipschitz_on UNIV (f^^n)"
by (induction n, auto intro!: lipschitz_onI lipschitz_on_compose2[of 1 UNIV _ 1 f, simplified] lipschitz_on_subset[OF assms])

text ‹If $f$ is a semicontraction, then its stable translation length is the limit of $d(x, f^n x)/n$
for any $n$. While it is obvious that the liminf of this quantity is at least the stable translation
length (which is defined as an inf over all points and all times), the opposite inequality is more
interesting. One may find a point $y$ and a time $k$ for which $d(y, f^k y)/k$ is very close to the
stable translation length. By subadditivity of the sequence $n \mapsto f(y, f^n y)$ and Fekete's
Lemma, it follows that, for any large $n$, then $d(y, f^n y)/n$ is also very close to the stable
translation length. Since this is equal to $d(x, f^n x)/n$ up to $\pm 2 d(x,y)/n$, the result
follows.›

proposition stable_translation_length_as_pointwise_limit:
  assumes "1-lipschitz_on UNIV f"
  shows "(λn. dist x ((f^^n) x)/n)  stable_translation_length f"
proof -
  have *: "subadditive (λn. dist y ((f^^n) y))" for y
  proof (rule subadditiveI)
    fix m n::nat
    have "dist y ((f ^^ (m + n)) y)  dist y ((f^^m) y) + dist ((f^^m) y) ((f^^(m+n)) y)"
      by (rule dist_triangle)
    also have "... = dist y ((f^^m) y) + dist ((f^^m) y) ((f^^m) ((f^^n) y))"
      by (auto simp add: funpow_add)
    also have "...  dist y ((f^^m) y) + dist y ((f^^n) y)"
      using semicontraction_iterates[OF assms, of m] unfolding lipschitz_on_def by auto
    finally show "dist y ((f ^^ (m + n)) y)  dist y ((f ^^ m) y) + dist y ((f ^^ n) y)"
      by simp
  qed
  have Ly: "(λn. dist y ((f^^n) y) / n)  Inf {dist y ((f^^n) y) / n |n. n > 0}" for y
    by (auto intro!: bdd_belowI[of _ 0] subadditive_converges_bounded'[OF subadditive_imp_eventually_subadditive[OF *]])
  have "eventually (λn. dist x ((f^^n) x)/n < l) sequentially" if "stable_translation_length f < l" for l
  proof -
    obtain m where m: "stable_translation_length f < m" "m < l"
      using ‹stable_translation_length f < l dense by auto
    have "t  {translation_length (f^^n)/n |n. n > 0}. t < m"
      apply (subst cInf_less_iff[symmetric])
      using m unfolding stable_translation_length_def by (auto intro!: bdd_belowI[of _ 0])
    then obtain k where k: "k > 0" "translation_length (f^^k)/k < m"
      by auto
    have "translation_length (f^^k) < k * m"
      using k by (simp add: divide_simps algebra_simps)
    then have "t  {dist y ((f^^k) y) |y. True}. t < k * m"
      apply (subst cInf_less_iff[symmetric])
      unfolding translation_length_def by (auto intro!: bdd_belowI[of _ 0])
    then obtain y where y: "dist y ((f^^k) y) < k * m"
      by auto
    have A: "eventually (λn. dist y ((f^^n) y)/n < m) sequentially"
      apply (auto intro!: order_tendstoD[OF Ly] iffD2[OF cInf_less_iff] bdd_belowI[of _ 0] exI[of _ "dist y ((f^^k) y)/k"])
      using y k by (auto simp add: algebra_simps divide_simps)
    have B: "eventually (λn. dist x y * (1/n) < (l-m)/2) sequentially"
      apply (intro order_tendstoD[of _ "dist x y * 0"] tendsto_intros)
      using m < l by simp
    have C: "dist x ((f^^n) x)/n < l" if "n > 0" "dist y ((f^^n) y)/n < m" "dist x y * (1/n) < (l-m)/2" for n
    proof -
      have "dist x ((f^^n) x)  dist x y + dist y ((f^^n) y) + dist ((f^^n) y) ((f^^n) x)"
        by (intro mono_intros)
      also have "...  dist x y + dist y ((f^^n) y) + dist y x"
        using semicontraction_iterates[OF assms, of n] unfolding lipschitz_on_def by auto
      also have "... = 2 * dist x y + dist y ((f^^n) y)"
        by (simp add: dist_commute)
      also have "... < 2 * real n * (l-m)/2 + n * m"
        apply (intro mono_intros) using that by (auto simp add: algebra_simps divide_simps)
      also have "... = n * l"
        by (simp add: algebra_simps divide_simps)
      finally show ?thesis
        using that by (simp add: algebra_simps divide_simps)
    qed
    show "eventually (λn. dist x ((f^^n) x)/n < l) sequentially"
      by (rule eventually_mono[OF eventually_conj[OF eventually_conj[OF A B] eventually_gt_at_top[of 0]] C], auto)
  qed
  moreover have "eventually (λn. dist x ((f^^n) x)/n > l) sequentially" if "stable_translation_length f > l" for l
  proof -
    have *: "dist x ((f^^n) x)/n > l" if "n > 0" for n
    proof -
      have "n * l < n * stable_translation_length f"
        using ‹stable_translation_length f > l n > 0 by auto
      also have "...  translation_length (f^^n)"
        by (intro mono_intros)
      also have "...  dist x ((f^^n) x)"
        by (intro mono_intros)
      finally show ?thesis
        using n > 0 by (auto simp add: algebra_simps divide_simps)
    qed
    then show ?thesis
      by (rule eventually_mono[rotated], auto)
  qed
  ultimately show ?thesis
    by (rule order_tendstoI[rotated])
qed

text ‹It follows from the previous proposition that the stable translation length is also the limit
of the renormalized translation length of $f^n$.›

proposition stable_translation_length_as_limit:
  assumes "1-lipschitz_on UNIV f"
  shows "(λn. translation_length (f^^n) / n)  stable_translation_length f"
proof -
  obtain x::'a where True by auto
  show ?thesis
  proof (rule tendsto_sandwich[of "λn. stable_translation_length f" _ _ "λn. dist x ((f^^n) x)/n"])
    have "stable_translation_length f  translation_length (f ^^ n) / real n" if "n > 0" for n
      using stable_translation_length_le_translation_length[of n f] that by (simp add: divide_simps algebra_simps)
    then show "eventually (λn. stable_translation_length f  translation_length (f ^^ n) / real n) sequentially"
      by (rule eventually_mono[rotated], auto)
    have "translation_length (f ^^ n) / real n  dist x ((f ^^ n) x) / real n" for n
      using translation_length_le[of "f^^n" x] by (auto simp add: divide_simps)
    then show "eventually (λn. translation_length (f ^^ n) / real n  dist x ((f ^^ n) x) / real n) sequentially"
      by auto
  qed (auto simp add: stable_translation_length_as_pointwise_limit[OF assms])
qed

lemma stable_translation_length_inv:
  assumes "isometry f"
  shows "stable_translation_length (inv f) = stable_translation_length f"
proof -
  have *: "dist basepoint (((inv f)^^n) basepoint) = dist basepoint ((f^^n) basepoint)" for n
  proof -
    have "basepoint = (f^^n) (((inv f)^^n) basepoint)"
      by (metis assms comp_apply fn_o_inv_fn_is_id isometry_inverse(2))
    then have "dist basepoint ((f^^n) basepoint) = dist ((f^^n) (((inv f)^^n) basepoint)) ((f^^n) basepoint)"
      by auto
    also have "... = dist (((inv f)^^n) basepoint) basepoint"
      unfolding isometryD(2)[OF isometry_iterates[OF assms]] by simp
    finally show ?thesis by (simp add: dist_commute)
  qed

  have "(λn. dist basepoint ((f^^n) basepoint)/n)  stable_translation_length f"
    using stable_translation_length_as_pointwise_limit[OF isometryD(4)[OF assms]] by simp
  moreover have "(λn. dist basepoint ((f^^n) basepoint)/n)  stable_translation_length (inv f)"
    unfolding *[symmetric]
    using stable_translation_length_as_pointwise_limit[OF isometryD(4)[OF isometry_inverse(1)[OF assms]]] by simp
  ultimately show ?thesis
    using LIMSEQ_unique by auto
qed

subsection ‹The strength of an isometry at a fixed point at infinity›

text ‹The additive strength of an isometry at a fixed point at infinity is the asymptotic average
every point is moved towards the fixed point at each step. It is measured using the Busemann
function.›

definition additive_strength::"('a::Gromov_hyperbolic_space  'a)  ('a Gromov_completion)  real"
  where "additive_strength f xi = lim (λn. (Busemann_function_at xi ((f^^n) basepoint) basepoint)/n)"

text ‹For additivity reasons, as the Busemann function is a quasi-morphism, the additive strength
measures the deplacement even at finite times. It is also uniform in terms of the basepoint. This
shows that an isometry sends horoballs centered at a fixed point to horoballs, up to a uniformly
bounded error depending only on $\delta$.›

lemma Busemann_function_eq_additive_strength:
  assumes "isometry f" "Gromov_extension f xi = xi"
  shows "¦Busemann_function_at xi ((f^^n) x) (x::'a::Gromov_hyperbolic_space) - real n * additive_strength f xi¦  2 * deltaG(TYPE('a))"
proof -
  define u where "u = (λy n. Busemann_function_at xi ((f^^n) y) y)"
  have *: "abs(u y (m+n) - u y m - u y n)  2 * deltaG(TYPE('a))" for n m y
  proof -
    have P: "Gromov_extension (f^^m) xi = xi"
      unfolding Gromov_extension_isometry_iterates[OF assms(1)] apply (induction m) using assms by auto
    have *: "u y n = Busemann_function_at xi ((f^^m) ((f^^n) y)) ((f^^m) y)"
      apply (subst P[symmetric]) unfolding Busemann_function_isometry[OF isometry_iterates[OF ‹isometry f]] u_def by auto
    show ?thesis
      unfolding * unfolding u_def using Busemann_function_quasi_morphism[of xi "(f^^(m+n)) y" "(f^^m) y" y]
      unfolding funpow_add comp_def by auto
  qed
  define l where "l = (λy. lim (λn. u y n/n))"
  have A: "abs(u y k - k * l y)  2 * deltaG(TYPE('a))" for y k
    unfolding l_def using almost_additive_converges(2) * by auto
  then have *: "abs(Busemann_function_at xi ((f^^k) y) y - k * l y)  2 * deltaG(TYPE('a))" for y k
    unfolding u_def by auto
  have "l basepoint = additive_strength f xi"
    unfolding l_def u_def additive_strength_def by auto

  have "abs(k * l basepoint - k * l x)  4 * deltaG(TYPE('a)) + 2 * dist basepoint x" for k::nat
  proof -
    have "abs(k * l basepoint - k * l x) = abs((Busemann_function_at xi ((f^^k) x) x - k * l x) - (Busemann_function_at xi ((f^^k) basepoint) basepoint - k * l basepoint)
                                                + (Busemann_function_at xi ((f^^k) basepoint) basepoint - Busemann_function_at xi ((f^^k) x) x))"
      by auto
    also have "...  abs (Busemann_function_at xi ((f^^k) x) x - k * l x) + abs (Busemann_function_at xi ((f^^k) basepoint) basepoint - k * l basepoint)
                      + abs (Busemann_function_at xi ((f^^k) basepoint) basepoint - Busemann_function_at xi ((f^^k) x) x)"
      by auto
    also have "...  2 * deltaG(TYPE('a)) + 2 * deltaG(TYPE('a)) + (dist ((f^^k) basepoint) ((f^^k) x) + dist basepoint x)"
      by (intro mono_intros *)
    also have "... = 4 * deltaG(TYPE('a)) + 2 * dist basepoint x"
      unfolding isometryD[OF isometry_iterates[OF assms(1)]] by auto
    finally show ?thesis by auto
  qed
  moreover have "u = v" if H: "k::nat. abs(k * u - k * v)  C" for u v C::real
  proof -
    have "(λn. abs(u - v))  0"
    proof (rule tendsto_sandwich[of "λn. 0" _ _ "λn::nat. C/n"], auto)
      have "(λn. C*(1/n))  C * 0" by (intro tendsto_intros)
      then show "(λn. C/n)  0" by auto
      have "¦u - v¦  C / real n" if "n  1" for n
        using H[of n] that apply (simp add: divide_simps algebra_simps)
        by (metis H abs_mult abs_of_nat right_diff_distrib')
      then show "F n in sequentially. ¦u - v¦  C / real n"
        unfolding eventually_sequentially by auto
    qed
    then show ?thesis
      by (metis LIMSEQ_const_iff abs_0_eq eq_iff_diff_eq_0)
  qed
  ultimately have "l basepoint = l x" by auto
  show ?thesis
    using A[of x n] unfolding u_def l basepoint = l x[symmetric] l basepoint = additive_strength f xi by auto
qed

lemma additive_strength_as_limit [tendsto_intros]:
  assumes "isometry f" "Gromov_extension f xi = xi"
  shows "(λn. Busemann_function_at xi ((f^^n) x) x/n)  additive_strength f xi"
proof -
  have "(λn. abs(Busemann_function_at xi ((f^^n) x) x/n - additive_strength f xi))  0"
    apply (rule tendsto_sandwich[of "λn. 0" _ _ "λn. (2 * deltaG(TYPE('a))) * (1/real n)"], auto)
    unfolding eventually_sequentially apply (rule exI[of _ 1])
    using Busemann_function_eq_additive_strength[OF assms] apply (simp add: divide_simps algebra_simps)
    using tendsto_mult[OF _ lim_1_over_n] by auto
  then show ?thesis
    using LIM_zero_iff tendsto_rabs_zero_cancel by blast
qed

text ‹The additive strength measures the amount of displacement towards a fixed point at infinity.
Therefore, the distance from $x$ to $f^n x$ is at least $n$ times the additive strength, but one
might think that it might be larger, if there is displacement along the horospheres. It turns out
that this is not the case: the displacement along the horospheres is at most logarithmic (this is
a classical property of parabolic isometries in hyperbolic spaces), and in fact it is bounded for
loxodromic elements.
We prove here that the growth is at most logarithmic in all cases, using a small computation based
on the hyperbolicity inequality, expressed in Lemma \verb+dist_minus_Busemann_max_ineq+ above.
This lemma will be used below to show that the translation length is the absolute value of the
additive strength.›

lemma dist_le_additive_strength:
  assumes "isometry (f::'a::Gromov_hyperbolic_space  'a)" "Gromov_extension f xi = xi" "additive_strength f xi  0" "n  1"
  shows "dist x ((f^^n) x)  dist x (f x) + real n * additive_strength f xi + ceiling (log 2 n) * 16 * deltaG(TYPE('a))"
proof -
  have A: "n. n  {1..2^k}  dist x ((f^^n) x) - real n * additive_strength f xi  dist x (f x) + k * 16 * deltaG(TYPE('a))" for k
  proof (induction k)
    case 0
    fix n::nat assume "n  {1..2^0}"
    then have "n = 1" by auto
    then show "dist x ((f^^n) x) - real n * additive_strength f xi  dist x (f x) + real 0 * 16 * deltaG(TYPE('a))"
      using assms(3) by auto
  next
    case (Suc k)
    fix N::nat assume "N  {1..2^(Suc k)}"
    then consider "N  {1..2^k}" | "N  {2^k<..2^(Suc k)}" using not_le by auto
    then show "dist x ((f ^^ N) x) - real N * additive_strength f xi  dist x (f x) + real (Suc k) * 16 * deltaG TYPE('a)"
    proof (cases)
      case 1
      show ?thesis by (rule order_trans[OF Suc.IH[OF 1]], auto simp add: algebra_simps)
    next
      case 2
      define m::nat where "m = N - 2^k"
      define n::nat where "n = 2^k"
      have nm: "N = n+m" "m  {1..2^k}" "n  {1..2^k}"unfolding m_def n_def using 2 by auto
      have *: "(f^^(n+m)) x = (f^^n) ((f^^m) x)"
        unfolding funpow_add comp_def by auto
      have **: "(f^^(n+m)) x = (f^^m) ((f^^n) x)"
        apply (subst add.commute) unfolding funpow_add comp_def by auto

      have "dist x ((f^^N) x) - N * additive_strength f xi - 2 * deltaG(TYPE('a))  dist x ((f^^(n+m)) x) - Busemann_function_at xi ((f^^(n+m)) x) x"
        unfolding nm(1) using Busemann_function_eq_additive_strength[OF assms(1) assms(2), of "n+m" x] by auto
      also have "...  max (dist x ((f^^n) x) - Busemann_function_at xi ((f^^n) x) x) (dist ((f^^n) x) ((f^^(n+m)) x) - Busemann_function_at xi ((f^^(n+m)) x) ((f^^n) x) - 2 * Busemann_function_at xi ((f^^n) x) x) + 8 * deltaG(TYPE('a))"
        using dist_minus_Busemann_max_ineq by auto
      also have "...  max (dist x ((f^^n) x) - (n * additive_strength f xi - 2 * deltaG(TYPE('a)))) (dist ((f^^n) x) ((f^^(n+m)) x) - (m * additive_strength f xi - 2 * deltaG(TYPE('a))) - 2 * (n * additive_strength f xi - 2 * deltaG(TYPE('a)))) + 8 * deltaG(TYPE('a))"
        unfolding ** apply (intro mono_intros)
        using Busemann_function_eq_additive_strength[OF assms(1) assms(2), of n x] Busemann_function_eq_additive_strength[OF assms(1) assms(2), of m "(f^^n) x"] by auto
      also have "...  max (dist x ((f^^n) x) - n * additive_strength f xi + 6 * deltaG(TYPE('a))) (dist x ((f^^m) x) - m * additive_strength f xi + 6 * deltaG(TYPE('a))) + 8 * deltaG(TYPE('a))"
        unfolding * isometryD(2)[OF isometry_iterates[OF assms(1)], of n] using assms(3) by (intro mono_intros, auto)
      also have "... = max (dist x ((f^^n) x) - n * additive_strength f xi) (dist x ((f^^m) x) - m * additive_strength f xi) + 14 * deltaG(TYPE('a))"
        unfolding max_add_distrib_left[symmetric] by auto
      also have "...  dist x (f x) + k * 16 * deltaG(TYPE('a)) + 14 * deltaG(TYPE('a))"
        using nm by (auto intro!: Suc.IH)
      finally show ?thesis by (auto simp add: algebra_simps)
    qed
  qed
  define k::nat where "k = nat(ceiling (log 2 n))"
  have "n  2^k" unfolding k_def
    by (meson less_log2_of_power not_le real_nat_ceiling_ge)
  then have "dist x ((f^^n) x) - real n * additive_strength f xi  dist x (f x) + k * 16 * deltaG(TYPE('a))"
    using A[of n k] n  1 by auto
  moreover have "real (nat log 2 (real n)) = real_of_int log 2 (real n)"
    by (metis Transcendental.log_one n  2 ^ k assms(4) ceiling_zero int_ops(2) k_def le_antisym nat_eq_iff2 of_int_1 of_int_of_nat_eq order_refl power_0)
  ultimately show ?thesis unfolding k_def by (auto simp add: algebra_simps)
qed

text ‹The strength of the inverse of a map is the opposite of the strength of the map.›

lemma additive_strength_inv:
  assumes "isometry (f::'a::Gromov_hyperbolic_space  'a)" "Gromov_extension f xi = xi"
  shows "additive_strength (inv f) xi = - additive_strength f xi"
proof -
  have *: "(inv f ^^ n) ((f ^^ n) x) = x" for n x
    by (metis assms(1) comp_apply inv_fn_o_fn_is_id isometry_inverse(2))
  have A: "abs(real n * additive_strength f xi + real n * additive_strength (inv f) xi)  6 * deltaG (TYPE('a))" for n::nat and x::'a
    using Busemann_function_quasi_morphism[of xi x "(f^^n) x" x] Busemann_function_eq_additive_strength[OF assms, of n x] Busemann_function_eq_additive_strength[OF isometry_inverse(1)[OF assms(1)]
    Gromov_extension_inv_fixed_point[OF assms], of n "(f^^n) x"] unfolding * by auto
  have B: "abs(additive_strength f xi + additive_strength (inv f) xi)  6 * deltaG(TYPE('a)) * (1/n)" if "n  1" for n::nat
    using that A[of n] apply (simp add: divide_simps algebra_simps) unfolding distrib_left[symmetric] by auto
  have "(λn. abs(additive_strength f xi + additive_strength (inv f) xi))  6 * deltaG(TYPE('a)) * 0"
    apply (rule tendsto_sandwich[of "λn. 0" _ _ "λn. 6 * deltaG(TYPE('a)) * (1/real n)"], simp)
    unfolding eventually_sequentially apply (rule exI[of _ 1]) using B apply simp
    by (simp, intro tendsto_intros)
  then show ?thesis
    using LIMSEQ_unique mult_zero_right tendsto_const by fastforce
qed

text ‹We will now prove that the stable translation length of an isometry is given by the absolute
value of its strength at any fixed point. We start with the case where the strength is nonnegative,
and then reduce to this case by considering the map or its inverse.›

lemma stable_translation_length_eq_additive_strength_aux:
  assumes "isometry (f::'a::Gromov_hyperbolic_space  'a)" "Gromov_extension f xi = xi" "additive_strength f xi  0"
  shows "stable_translation_length f = additive_strength f xi"
proof -
  have "(λn. dist x ((f^^n) x)/n)  additive_strength f xi" for x
  proof (rule tendsto_sandwich[of "λn. (n * additive_strength f xi - 2 * deltaG(TYPE('a)))/real n" _ _ "λn. (dist x (f x) + n * additive_strength f xi + ceiling (log 2 n) * 16 * deltaG(TYPE('a)))/ n"])
    have "n * additive_strength f xi - 2 * deltaG TYPE('a)  dist x ((f ^^ n) x)" for n
      using Busemann_function_eq_additive_strength[OF assms(1) assms(2), of n x] Busemann_function_le_dist[of xi "(f^^n) x" x]
      by (simp add: dist_commute)
    then have "(n * additive_strength f xi - 2 * deltaG TYPE('a)) / n  dist x ((f ^^ n) x) / n" if "n  1" for n
      using that by (simp add: divide_simps)
    then show "F n in sequentially. (real n * additive_strength f xi - 2 * deltaG TYPE('a)) / real n  dist x ((f ^^ n) x) / real n"
      unfolding eventually_sequentially by auto

    have B: "(λn. additive_strength f xi - (2 * deltaG(TYPE('a))) * (1/n))  additive_strength f xi - (2 * deltaG(TYPE('a))) * 0"
      by (intro tendsto_intros)
    show "(λn. (real n * additive_strength f xi - 2 * deltaG TYPE('a)) / real n)  additive_strength f xi"
    proof (rule Lim_transform_eventually)
      show "eventually (λn. additive_strength f xi - (2 * deltaG(TYPE('a))) * (1/n) = (real n * additive_strength f xi - 2 * deltaG TYPE('a)) / real n) sequentially"
        unfolding eventually_sequentially apply (rule exI[of _ 1]) by (simp add: divide_simps)
    qed (use B in auto)

    have "dist x ((f^^n) x)  dist x (f x) + n * additive_strength f xi + ceiling (log 2 n) * 16 * deltaG(TYPE('a))" if "n  1" for n
      using dist_le_additive_strength[OF assms that] by simp
    then have "(dist x ((f^^n) x))/n  (dist x (f x) + n * additive_strength f xi + ceiling (log 2 n) * 16 * deltaG(TYPE('a)))/n" if "n  1" for n
      using that by (simp add: divide_simps)
    then show "F n in sequentially. dist x ((f ^^ n) x) / real n  (dist x (f x) + real n * additive_strength f xi + real_of_int (log 2 (real n) * 16) * deltaG TYPE('a)) / real n"
      unfolding eventually_sequentially by auto

    have B: "(λn. dist x (f x) * (1/n) + additive_strength f xi + 16 * deltaG TYPE('a) * (log 2 n / n))  dist x (f x) * 0 + additive_strength f xi + 16 * deltaG TYPE('a) * 0"
      by (intro tendsto_intros)
    show "(λn. (dist x (f x) + n * additive_strength f xi + real_of_int (log 2 n * 16) * deltaG TYPE('a)) / real n)  additive_strength f xi"
    proof (rule Lim_transform_eventually)
      show "eventually (λn. dist x (f x) * (1/n) + additive_strength f xi + 16 * deltaG TYPE('a) * (log 2 n / n) = (dist x (f x) + real n * additive_strength f xi + real_of_int (log 2 (real n) * 16) * deltaG TYPE('a)) / real n) sequentially"
        unfolding eventually_sequentially apply (rule exI[of _ 1]) by (simp add: algebra_simps divide_simps)
    qed (use B in auto)
  qed
  then show ?thesis
    using LIMSEQ_unique stable_translation_length_as_pointwise_limit[OF isometryD(4)[OF assms(1)]] by blast
qed

lemma stable_translation_length_eq_additive_strength:
  assumes "isometry (f::'a::Gromov_hyperbolic_space  'a)" "Gromov_extension f xi = xi"
  shows "stable_translation_length f = abs(additive_strength f xi)"
proof (cases "additive_strength f xi  0")
  case True
  then show ?thesis using stable_translation_length_eq_additive_strength_aux[OF assms] by auto
next
  case False
  then have *: "abs(additive_strength f xi) = additive_strength (inv f) xi"
    unfolding additive_strength_inv[OF assms] by auto
  show ?thesis
    unfolding * stable_translation_length_inv[OF assms(1), symmetric]
    using stable_translation_length_eq_additive_strength_aux[OF isometry_inverse(1)[OF assms(1)] Gromov_extension_inv_fixed_point[OF assms]] * by auto
qed


subsection ‹Elliptic isometries›

text ‹Elliptic isometries are the simplest ones: they have bounded orbits.›

definition elliptic_isometry::"('a::Gromov_hyperbolic_space  'a)  bool"
  where "elliptic_isometry f = (isometry f  (x. bounded {(f^^n) x|n. True}))"

lemma elliptic_isometryD:
  assumes "elliptic_isometry f"
  shows "bounded {(f^^n) x |n. True}"
        "isometry f"
using assms unfolding elliptic_isometry_def by auto

lemma elliptic_isometryI [intro]:
  assumes "bounded {(f^^n) x |n. True}"
          "isometry f"
  shows "elliptic_isometry f"
proof -
  have "bounded {(f^^n) y |n. True}" for y
  proof -
    obtain c e where c: "n. dist c ((f^^n) x)  e"
      using assms(1) unfolding bounded_def by auto
    have "dist c ((f^^n) y)  e + dist x y" for n
    proof -
      have "dist c ((f^^n) y)  dist c ((f^^n) x) + dist ((f^^n) x) ((f^^n) y)"
        by (intro mono_intros)
      also have "...  e + dist x y"
        using c[of n] isometry_iterates[OF assms(2), of n] by (intro mono_intros, auto simp add: isometryD)
      finally show ?thesis by simp
    qed
    then show ?thesis
      unfolding bounded_def by auto
  qed
  then show ?thesis unfolding elliptic_isometry_def using assms by auto
qed

text ‹The inverse of an elliptic isometry is an elliptic isometry.›

lemma elliptic_isometry_inv:
  assumes "elliptic_isometry f"
  shows "elliptic_isometry (inv f)"
proof -
  obtain c e where A: "n. dist c ((f^^n) basepoint)  e"
    using elliptic_isometryD(1)[OF assms, of basepoint] unfolding bounded_def by auto
  have "c = (f^^n) (((inv f)^^n) c)" for n
    using fn_o_inv_fn_is_id[OF isometry_inverse(2)[OF elliptic_isometryD(2)[OF assms]], of n]
    unfolding comp_def by metis
  then have "dist ((f^^n) (((inv f)^^n) c)) ((f^^n) basepoint)  e" for n
    using A by auto
  then have B: "dist basepoint (((inv f)^^n) c)  e" for n
    unfolding isometryD(2)[OF isometry_iterates[OF elliptic_isometryD(2)[OF assms]]] by (auto simp add: dist_commute)
  show ?thesis
    apply (rule elliptic_isometryI[of _ c])
    using isometry_inverse(1)[OF elliptic_isometryD(2)[OF assms]] B unfolding bounded_def by auto
qed

text ‹The inverse of a bijective map is an elliptic isometry if and only if the original map is.›

lemma elliptic_isometry_inv_iff:
  assumes "bij f"
  shows "elliptic_isometry (inv f)  elliptic_isometry f"
using elliptic_isometry_inv[of f] elliptic_isometry_inv[of "inv f"] inv_inv_eq[OF assms] by auto

text ‹The identity is an elliptic isometry.›

lemma elliptic_isometry_id:
  "elliptic_isometry id"
by (intro elliptic_isometryI isometryI, auto)

text ‹The translation length of an elliptic isometry is $0$.›

lemma elliptic_isometry_stable_translation_length:
  assumes "elliptic_isometry f"
  shows "stable_translation_length f = 0"
proof -
  obtain x::'a where True by auto
  have "bounded {(f^^n) x|n. True}"
    using elliptic_isometryD[OF assms] by auto
  then obtain c C where cC: "n. dist c ((f^^n) x)  C"
    unfolding bounded_def by auto
  have "(λn. dist x ((f^^n) x)/n)  0"
  proof (rule tendsto_sandwich[of "λ_. 0" _ sequentially "λn. 2 * C / n"])
    have "(λn. 2 * C * (1 / real n))  2 * C * 0" by (intro tendsto_intros)
    then show "(λn. 2 * C / real n)  0" by auto
    have "dist x ((f ^^ n) x) / real n  2 * C / real n" for n
      using cC[of 0] cC[of n] dist_triangle[of x "(f^^n) x" c] by (auto simp add: algebra_simps divide_simps dist_commute)
    then show "eventually (λn. dist x ((f ^^ n) x) / real n  2 * C / real n) sequentially"
      by auto
  qed (auto)
  moreover have "(λn. dist x ((f^^n) x)/n)  stable_translation_length f"
    by (rule stable_translation_length_as_pointwise_limit[OF isometry_on_lipschitz[OF isometryD(1)[OF elliptic_isometryD(2)[OF assms]]]])
  ultimately show ?thesis
    using LIMSEQ_unique by auto
qed

text ‹If an isometry has a fixed point, then it is elliptic.›

lemma isometry_with_fixed_point_is_elliptic:
  assumes "isometry f" "f x = x"
  shows "elliptic_isometry f"
proof -
  have *: "(f^^n) x = x" for n
    apply (induction n) using assms(2) by auto
  show ?thesis
    apply (rule elliptic_isometryI[of _ x, OF _ assms(1)]) unfolding * by auto
qed


subsection ‹Parabolic and loxodromic isometries›

text ‹An isometry is parabolic if it is not elliptic and if its translation length vanishes.›

definition parabolic_isometry::"('a::Gromov_hyperbolic_space  'a)  bool"
  where "parabolic_isometry f = (isometry f  ¬elliptic_isometry f  stable_translation_length f = 0)"

text ‹An isometry is loxodromic if it is not elliptic and if its translation length is nonzero.›

definition loxodromic_isometry::"('a::Gromov_hyperbolic_space  'a)  bool"
  where "loxodromic_isometry f = (isometry f  ¬elliptic_isometry f  stable_translation_length f  0)"

text ‹The main features of such isometries are expressed in terms of their fixed points at infinity.
We define them now, but proving that the definitions make sense will take some work.›

definition neutral_fixed_point::"('a::Gromov_hyperbolic_space  'a)  'a Gromov_completion"
  where "neutral_fixed_point f = (SOME xi. xi  Gromov_boundary  Gromov_extension f xi = xi  additive_strength f xi = 0)"

definition attracting_fixed_point::"('a::Gromov_hyperbolic_space  'a)  'a Gromov_completion"
  where "attracting_fixed_point f = (SOME xi. xi  Gromov_boundary  Gromov_extension f xi = xi  additive_strength f xi < 0)"

definition repelling_fixed_point::"('a::Gromov_hyperbolic_space  'a)  'a Gromov_completion"
  where "repelling_fixed_point f = (SOME xi. xi  Gromov_boundary  Gromov_extension f xi = xi  additive_strength f xi > 0)"


lemma parabolic_isometryD:
  assumes "parabolic_isometry f"
  shows "isometry f"
        "¬bounded {(f^^n) x|n. True}"
        "stable_translation_length f = 0"
        "¬elliptic_isometry f"
using assms unfolding parabolic_isometry_def by auto

lemma parabolic_isometryI:
  assumes "isometry f"
          "¬bounded {(f^^n) x|n. True}"
          "stable_translation_length f = 0"
  shows "parabolic_isometry f"
using assms unfolding parabolic_isometry_def elliptic_isometry_def by auto

lemma loxodromic_isometryD:
  assumes "loxodromic_isometry f"
  shows "isometry f"
        "¬bounded {(f^^n) x|n. True}"
        "stable_translation_length f > 0"
        "¬elliptic_isometry f"
using assms unfolding loxodromic_isometry_def
by (auto, meson dual_order.antisym not_le stable_translation_length_nonneg)

text ‹To have a loxodromic isometry, it suffices to know that the stable translation length is
nonzero, as elliptic isometries have zero translation length.›

lemma loxodromic_isometryI:
  assumes "isometry f"
          "stable_translation_length f  0"
  shows "loxodromic_isometry f"
using assms elliptic_isometry_stable_translation_length unfolding loxodromic_isometry_def by auto

text ‹Any isometry is elliptic, or parabolic, or loxodromic, and these possibilities are mutually
exclusive.›

lemma elliptic_or_parabolic_or_loxodromic:
  assumes "isometry f"
  shows "elliptic_isometry f  parabolic_isometry f  loxodromic_isometry f"
using assms unfolding parabolic_isometry_def loxodromic_isometry_def by auto

lemma elliptic_imp_not_parabolic_loxodromic:
  assumes "elliptic_isometry f"
  shows "¬parabolic_isometry f"
        "¬loxodromic_isometry f"
using assms unfolding parabolic_isometry_def loxodromic_isometry_def by auto

lemma parabolic_imp_not_elliptic_loxodromic:
  assumes "parabolic_isometry f"
  shows "¬elliptic_isometry f"
        "¬loxodromic_isometry f"
using assms unfolding parabolic_isometry_def loxodromic_isometry_def by auto

lemma loxodromic_imp_not_elliptic_parabolic:
  assumes "loxodromic_isometry f"
  shows "¬elliptic_isometry f"
        "¬parabolic_isometry f"
using assms unfolding parabolic_isometry_def loxodromic_isometry_def by auto

text ‹The inverse of a parabolic isometry is parabolic.›

lemma parabolic_isometry_inv:
  assumes "parabolic_isometry f"
  shows "parabolic_isometry (inv f)"
unfolding parabolic_isometry_def using isometry_inverse[of f] elliptic_isometry_inv_iff[of f]
parabolic_isometryD[OF assms] stable_translation_length_inv[of f] by auto

text ‹The inverse of a loxodromic isometry is loxodromic.›

lemma loxodromic_isometry_inv:
  assumes "loxodromic_isometry f"
  shows "loxodromic_isometry (inv f)"
unfolding loxodromic_isometry_def using isometry_inverse[of f] elliptic_isometry_inv_iff[of f]
loxodromic_isometryD[OF assms] stable_translation_length_inv[of f] by auto

text ‹We will now prove that an isometry which is not elliptic has a fixed point at infinity. This
is very easy if the space is proper (ensuring that the Gromov completion is compact), but in fact
this holds in general. One constructs it by considering a sequence $r_n$ such that $f^{r_n} 0$ tends
to infinity, and additionally $d(f^l 0, 0) < d(f^{r_n} 0, 0)$ for $l < r_n$: this implies the
convergence at infinity of $f^{r_n} 0$, by an argument based on a Gromov product computation -- and
the limit is a fixed point. Moreover, it has nonpositive additive strength, essentially by
construction.›

lemma high_scores:
  fixes u::"nat  real" and i::nat and C::real
  assumes "¬(bdd_above (range u))"
  shows "n. (l  n. u l  u n)  u n  C  n  i"
proof -
  define M where "M = max C (Max {u l|l. l < i})"
  define n where "n = Inf {m. u m > M}"
  have "¬(range u  {..M})"
    using assms by (meson bdd_above_Iic bdd_above_mono)
  then have "{m. u m > M}  {}"
    using assms by (simp add: image_subset_iff not_less)
  then have "n  {m. u m > M}" unfolding n_def using Inf_nat_def1 by metis
  then have "u n > M" by simp
  have "n  i"
  proof (rule ccontr)
    assume "¬ i  n"
    then have *: "n < i" by simp
    have "u n  Max {u l|l. l < i}" apply (rule Max_ge) using * by auto
    then show False using u n > M M_def by auto
  qed
  moreover have "u l  u n" if "l  n" for l
  proof (cases "l = n")
    case True
    then show ?thesis by simp
  next
    case False
    then have "l < n" using l  n by auto
    then have "l  {m. u m > M}"
      unfolding n_def by (meson bdd_below_def cInf_lower not_le zero_le)
    then show ?thesis using u n > M by auto
  qed
  ultimately show ?thesis
    using u n > M M_def less_eq_real_def by auto
qed

lemma isometry_not_elliptic_has_attracting_fixed_point:
  assumes "isometry f"
          "¬(elliptic_isometry f)"
  shows "xi  Gromov_boundary. Gromov_extension f xi = xi  additive_strength f xi  0"
proof -
  define u where "u = (λn. dist basepoint ((f^^n) basepoint))"
  have NB: "¬(bdd_above (range u))"
  proof
    assume "bdd_above (range u)"
    then obtain C where *: "n. u n  C" unfolding bdd_above_def by auto
    have "bounded {(f^^n) basepoint|n. True}"
      unfolding bounded_def apply (rule exI[of _ basepoint], rule exI[of _ C])
      using * unfolding u_def by auto
    then show False
      using elliptic_isometryI assms by auto
  qed
  have "r. n. ((l  r n. u l  u (r n))  u (r n)  2 * n)  r (Suc n)  r n + 1"
    apply (rule dependent_nat_choice) using high_scores[OF NB] by (auto) blast
  then obtain r::"nat  nat" where r: "n l. l  r n  u l  u (r n)"
                                       "n. u (r n)  2 * n" "n. r (Suc n)  r n + 1"
    by auto
  then have "strict_mono r"
    by (metis Suc_eq_plus1 Suc_le_lessD strict_monoI_Suc)
  then have "r n  n" for n
    by (simp add: seq_suble)

  have A: "dist ((f^^(r p)) basepoint) ((f^^(r n)) basepoint)  dist basepoint ((f^^(r n)) basepoint)" if "n  p" for n p
  proof -
    have "r n  r p" using n  p ‹strict_mono r by (simp add: strict_mono_less_eq)
    then have *: "f^^((r n)) = (f^^(r p)) o (f^^(r n - r p))"
      unfolding funpow_add[symmetric] by auto
    have "dist ((f^^(r p)) basepoint) ((f^^(r n)) basepoint) = dist ((f^^(r p)) basepoint) ((f^^(r p)) ((f^^(r n - r p)) basepoint))"
      unfolding * comp_def by auto
    also have "... = dist basepoint ((f^^(r n - r p)) basepoint)"
      using isometry_iterates[OF assms(1), of "r p"] isometryD by auto
    also have "...  dist basepoint ((f^^(r n)) basepoint)"
      using r(1)[of "r n - r p" n] unfolding u_def by auto
    finally show ?thesis
      by simp
  qed

  have *: "Gromov_product_at basepoint ((f^^(r p)) basepoint) ((f^^(r n)) basepoint)  p" if "n  p" for n p
  proof -
    have "2 * Gromov_product_at basepoint ((f^^(r p)) basepoint) ((f^^(r n)) basepoint)
            = dist basepoint ((f^^(r p)) basepoint) + dist basepoint ((f^^(r n)) basepoint)
              - dist ((f^^(r p)) basepoint) ((f^^(r n)) basepoint)"
      unfolding Gromov_product_at_def by auto
    also have "...  dist basepoint ((f^^(r p)) basepoint)"
      using A[OF that] by auto
    finally show "Gromov_product_at basepoint ((f^^(r p)) basepoint) ((f^^(r n)) basepoint)  p"
      using r(2)[of p] unfolding u_def by auto
  qed
  have *: "Gromov_product_at basepoint ((f^^(r p)) basepoint) ((f^^(r n)) basepoint)  N" if "n  N" "p  N" for n p N
    using *[of n p] *[of p n] that by (auto simp add: Gromov_product_commute intro: le_cases[of n p])
  have "Gromov_converging_at_boundary (λn. (f^^(r n)) basepoint)"
    apply (rule Gromov_converging_at_boundaryI[of basepoint]) using * by (meson dual_order.trans real_arch_simple)
  with Gromov_converging_at_boundary_converges[OF this]
  obtain xi where xi: "(λn. to_Gromov_completion ((f^^(r n)) basepoint))  xi" "xi  Gromov_boundary"
    by auto
  then have *: "(λn. Gromov_extension f (to_Gromov_completion ((f^^(r n)) basepoint)))  xi"
    apply (simp, rule Gromov_converging_at_boundary_bounded_perturbation[of _ _ _ "dist basepoint (f basepoint)"])
    by (simp add: assms(1) funpow_swap1 isometryD(2) isometry_iterates)
  moreover have "(λn. Gromov_extension f (to_Gromov_completion ((f^^(r n)) basepoint)))  Gromov_extension f xi"
    using continuous_on_tendsto_compose[OF Gromov_extension_isometry(2)[OF assms(1)] xi(1)] by auto
  ultimately have fxi: "Gromov_extension f xi = xi"
    using LIMSEQ_unique by auto

  have "Busemann_function_at (to_Gromov_completion ((f^^(r n)) basepoint)) ((f^^(r p)) basepoint) basepoint  0" if "n  p" for n p
    unfolding Busemann_function_inner using A[OF that] by auto
  then have A: "eventually (λn. Busemann_function_at (to_Gromov_completion ((f^^(r n)) basepoint)) ((f^^(r p)) basepoint) basepoint  0) sequentially" for p
    unfolding eventually_sequentially by auto
  have B: "eventually (λn. Busemann_function_at (to_Gromov_completion ((f^^(r n)) basepoint)) ((f^^(r p)) basepoint) basepoint  Busemann_function_at xi ((f^^(r p)) basepoint) basepoint - 2 * deltaG(TYPE('a)) - 1) sequentially" for p
    by (rule eventually_mono[OF Busemann_function_inside_approx[OF _ xi(1), of 1 "((f^^(r p)) basepoint)" basepoint, simplified]], simp)
  have "eventually (λn. Busemann_function_at xi ((f^^(r p)) basepoint) basepoint - 2 * deltaG(TYPE('a)) - 1  0) sequentially" for p
    by (rule eventually_mono[OF eventually_conj[OF A[of p] B[of p]]], simp)
  then have *: "Busemann_function_at xi ((f^^(r p)) basepoint) basepoint - 2 * deltaG(TYPE('a)) - 1  0" for p
    by auto
  then have A: "Busemann_function_at xi ((f^^(r p)) basepoint) basepoint / (r p) - (2 * deltaG(TYPE('a)) + 1) * (1/r p)  0" if "p  1" for p
    using order_trans[OF that p  r p] by (auto simp add: algebra_simps divide_simps)
  have B: "(λp. Busemann_function_at xi ((f^^(p)) basepoint) basepoint / p - (2 * deltaG(TYPE('a)) + 1) * (1/p))  additive_strength f xi - (2 * deltaG(TYPE('a)) + 1) * 0"
    by (intro tendsto_intros assms fxi)
  have "additive_strength f xi - (2 * deltaG TYPE('a) + 1) * 0  0"
    apply (rule LIMSEQ_le_const2[OF LIMSEQ_subseq_LIMSEQ[OF B ‹strict_mono r]]) using A unfolding comp_def by auto
  then show ?thesis using xi fxi by auto
qed

text ‹Applying the previous result to the inverse map, we deduce that there is also a fixed point
with nonnegative strength.›

lemma isometry_not_elliptic_has_repelling_fixed_point:
  assumes "isometry f"
          "¬(elliptic_isometry f)"
  shows "xi  Gromov_boundary. Gromov_extension f xi = xi  additive_strength f xi  0"
proof -
  have *: "¬elliptic_isometry (inv f)"
    using elliptic_isometry_inv_iff isometry_inverse(2)[OF assms(1)] assms(2) by auto
  obtain xi where xi: "xi  Gromov_boundary" "Gromov_extension (inv f) xi = xi" "additive_strength (inv f) xi  0"
    using isometry_not_elliptic_has_attracting_fixed_point[OF isometry_inverse(1)[OF assms(1)] *] by auto
  have *: "Gromov_extension f xi = xi"
    using Gromov_extension_inv_fixed_point[OF isometry_inverse(1)[OF assms(1)] xi(2)] inv_inv_eq[OF isometry_inverse(2)[OF assms(1)]] by auto
  moreover have "additive_strength f xi  0"
    using additive_strength_inv[OF assms(1) *] xi(3) by auto
  ultimately show ?thesis
    using xi(1) by auto
qed

subsubsection ‹Parabolic isometries›

text ‹We show that a parabolic isometry has (at least) one neutral fixed point at infinity.›

lemma parabolic_fixed_point:
  assumes "parabolic_isometry f"
  shows "neutral_fixed_point f  Gromov_boundary"
        "Gromov_extension f (neutral_fixed_point f) = neutral_fixed_point f"
        "additive_strength f (neutral_fixed_point f) = 0"
proof -
  obtain xi where xi: "xi  Gromov_boundary" "Gromov_extension f xi = xi"
    using isometry_not_elliptic_has_attracting_fixed_point parabolic_isometryD[OF assms] by blast
  moreover have "additive_strength f xi = 0"
    using stable_translation_length_eq_additive_strength[OF parabolic_isometryD(1)[OF assms] xi(2)]
    parabolic_isometryD(3)[OF assms] by auto
  ultimately have A: "xi. xi  Gromov_boundary  Gromov_extension f xi = xi  additive_strength f xi = 0"
    by auto
  show "neutral_fixed_point f  Gromov_boundary"
        "Gromov_extension f (neutral_fixed_point f) = neutral_fixed_point f"
        "additive_strength f (neutral_fixed_point f) = 0"
    unfolding neutral_fixed_point_def using someI_ex[OF A] by auto
qed

text ‹Parabolic isometries have exactly one fixed point, the neutral fixed point at infinity. The
proof goes as follows: if it has another fixed point, then the orbit of a basepoint would stay
on the horospheres centered at both fixed points. But the intersection of two horospheres based
at different points is a a bounded set. Hence, the map has a bounded orbit, and is therefore
elliptic.›

theorem parabolic_unique_fixed_point:
  assumes "parabolic_isometry f"
  shows "Gromov_extension f xi = xi  xi = neutral_fixed_point f"
proof (auto simp add: parabolic_fixed_point[OF assms])
  assume H: "Gromov_extension f xi = xi"
  have *: "additive_strength f xi = 0"
    using stable_translation_length_eq_additive_strength[OF parabolic_isometryD(1)[OF assms] H]
    parabolic_isometryD(3)[OF assms] by auto
  show "xi = neutral_fixed_point f"
  proof (rule ccontr)
    assume N: "xi  neutral_fixed_point f"
    define C where "C = 2 * real_of_ereal (extended_Gromov_product_at basepoint xi (neutral_fixed_point f)) + 4 * deltaG(TYPE('a))"
    have A: "dist basepoint ((f^^n) basepoint)  C" for n
    proof -
      have "dist ((f^^n) basepoint) basepoint - 2 * real_of_ereal (extended_Gromov_product_at basepoint xi (neutral_fixed_point f)) - 2 * deltaG(TYPE('a))
             max (Busemann_function_at xi ((f^^n) basepoint) basepoint) (Busemann_function_at (neutral_fixed_point f) ((f^^n) basepoint) basepoint)"
        using dist_le_max_Busemann_functions[OF N] by (simp add: algebra_simps)
      also have "...  max (n * additive_strength f xi + 2 * deltaG(TYPE('a))) (n * additive_strength f (neutral_fixed_point f) + 2 * deltaG(TYPE('a)))"
        apply (intro mono_intros)
        using Busemann_function_eq_additive_strength[OF parabolic_isometryD(1)[OF assms] H, of n basepoint]
        Busemann_function_eq_additive_strength[OF parabolic_isometryD(1)[OF assms] parabolic_fixed_point(2)[OF assms], of n basepoint]
        by auto
      also have "... = 2 * deltaG(TYPE('a))"
        unfolding * parabolic_fixed_point[OF assms] by auto
      finally show ?thesis
        unfolding C_def by (simp add: algebra_simps dist_commute)
    qed
    have "elliptic_isometry f"
      apply (rule elliptic_isometryI[of _ basepoint])
      using parabolic_isometryD(1)[OF assms] A unfolding bounded_def by auto
    then show False
      using elliptic_imp_not_parabolic_loxodromic assms by auto
  qed
qed

text ‹When one iterates a parabolic isometry, the distance to the starting point can grow at most
logarithmically.›

lemma parabolic_logarithmic_growth:
  assumes "parabolic_isometry (f::'a::Gromov_hyperbolic_space  'a)" "n  1"
  shows "dist x ((f^^n) x)  dist x (f x) + ceiling (log 2 n) * 16 * deltaG(TYPE('a))"
using dist_le_additive_strength[OF parabolic_isometryD(1)[OF assms(1)] parabolic_fixed_point(2)[OF assms(1)] _ assms(2)]
parabolic_isometryD(3)[OF assms(1)] stable_translation_length_eq_additive_strength[OF parabolic_isometryD(1)[OF assms(1)] parabolic_fixed_point(2)[OF assms(1)]]
by auto

text ‹It follows that there is no parabolic isometry in trees, since the formula in the previous
lemma shows that there is no orbit growth as $\delta = 0$, and therefore orbits are bounded,
contradicting the parabolicity of the isometry.›

lemma tree_no_parabolic_isometry:
  assumes "isometry (f::'a::Gromov_hyperbolic_space_0  'a)"
  shows "elliptic_isometry f  loxodromic_isometry f"
proof -
  have "¬parabolic_isometry f"
  proof
    assume P: "parabolic_isometry f"
    have "dist basepoint ((f^^n) basepoint)  dist basepoint (f basepoint)" if "n  1" for n
      using parabolic_logarithmic_growth[OF P that, of basepoint] by auto
    then have *: "dist basepoint ((f^^n) basepoint)  dist basepoint (f basepoint)" for n
      by (cases "n  1", auto simp add: not_less_eq_eq)
    have "elliptic_isometry f"
      apply (rule elliptic_isometryI[OF _ assms, of basepoint]) using * unfolding bounded_def by auto
    then show False
      using elliptic_imp_not_parabolic_loxodromic P by auto
  qed
  then show ?thesis
    using elliptic_or_parabolic_or_loxodromic[OF assms] by auto
qed


subsubsection ‹Loxodromic isometries›

text ‹A loxodromic isometry has (at least) two fixed points at infinity, one attracting
and one repelling. We have already constructed fixed points with nonnegative and nonpositive
strengths. Since the strength is nonzero (its absolute value is the stable translation length),
then these fixed points correspond to what we want.›

lemma loxodromic_attracting_fixed_point:
  assumes "loxodromic_isometry f"
  shows "attracting_fixed_point f  Gromov_boundary"
        "Gromov_extension f (attracting_fixed_point f) = attracting_fixed_point f"
        "additive_strength f (attracting_fixed_point f) < 0"
proof -
  obtain xi where xi: "xi  Gromov_boundary" "Gromov_extension f xi = xi" "additive_strength f xi  0"
    using isometry_not_elliptic_has_attracting_fixed_point loxodromic_isometryD[OF assms] by blast
  moreover have "additive_strength f xi < 0"
    using stable_translation_length_eq_additive_strength[OF loxodromic_isometryD(1)[OF assms] xi(2)]
    loxodromic_isometryD(3)[OF assms] xi(3) by auto
  ultimately have A: "xi. xi  Gromov_boundary  Gromov_extension f xi = xi  additive_strength f xi < 0"
    by auto
  show "attracting_fixed_point f  Gromov_boundary"
       "Gromov_extension f (attracting_fixed_point f) = attracting_fixed_point f"
       "additive_strength f (attracting_fixed_point f) < 0"
    unfolding attracting_fixed_point_def using someI_ex[OF A] by auto
qed

lemma loxodromic_repelling_fixed_point:
  assumes "loxodromic_isometry f"
  shows "repelling_fixed_point f  Gromov_boundary"
        "Gromov_extension f (repelling_fixed_point f) = repelling_fixed_point f"
        "additive_strength f (repelling_fixed_point f) > 0"
proof -
  obtain xi where xi: "xi  Gromov_boundary" "Gromov_extension f xi = xi" "additive_strength f xi  0"
    using isometry_not_elliptic_has_repelling_fixed_point loxodromic_isometryD[OF assms] by blast
  moreover have "additive_strength f xi > 0"
    using stable_translation_length_eq_additive_strength[OF loxodromic_isometryD(1)[OF assms] xi(2)]
    loxodromic_isometryD(3)[OF assms] xi(3) by auto
  ultimately have A: "xi. xi  Gromov_boundary  Gromov_extension f xi = xi  additive_strength f xi > 0"
    by auto
  show "repelling_fixed_point f  Gromov_boundary"
       "Gromov_extension f (repelling_fixed_point f) = repelling_fixed_point f"
       "additive_strength f (repelling_fixed_point f) > 0"
    unfolding repelling_fixed_point_def using someI_ex[OF A] by auto
qed

text ‹The attracting and repelling fixed points of a loxodromic isometry are distinct -- precisely
since one is attracting and the other is repelling.›

lemma attracting_fixed_point_neq_repelling_fixed_point:
  assumes "loxodromic_isometry f"
  shows "attracting_fixed_point f  repelling_fixed_point f"
using loxodromic_repelling_fixed_point[OF assms] loxodromic_attracting_fixed_point[OF assms] by auto

text ‹The attracting fixed point of a loxodromic isometry is indeed attracting. Moreover, the
convergence is uniform away from the repelling fixed point. This is expressed in the following
proposition, where neighborhoods of the repelling and attracting fixed points are given by the property
that the Gromov product with the fixed point is large.

The proof goes as follows. First, the Busemann function with respect to the fixed points at infinity
evolves like the strength. Therefore, $f^n e$ tends to the repulsive fixed point in negative time,
and to the attracting one in positive time. Consider now a general point $x$ with
$(\xi^-, x)_e \leq K$. This means that the geodesics from $e$ to $x$ and $\xi^-$ diverge before
time $K$. For large $n$, since $f^{-n} e$ is close to $\xi^-$, we also get the inequality
$(f^{-n} e, x)_e \leq K$. Applying $f^n$ and using the invariance of the Gromov product under
isometries yields $(e, f^n x)_{f^n e} \leq K$. But this Gromov product is equal to
$d(e, f^n e) - (f^n e, f^n x)_e$ (this is a general property of Gromov products). In particular,
$(f^n e, f^n x) \geq d(e, f^n e) - K$, and moreover $d(e, f^n e)$ is large.
Since $f^n e$ is close to $\xi^+$, it follows that $f^n x$
is also close to $\xi^+$, as desired.

The real proof requires some more care as everything should be done in ereal, and moreover every
inequality is only true up to some multiple of $\delta$. But everything works in the way just
described above.
›

proposition loxodromic_attracting_fixed_point_attracts_uniformly:
  assumes "loxodromic_isometry f"
  shows "N. n  N. x. extended_Gromov_product_at basepoint x (repelling_fixed_point f)  ereal K
           extended_Gromov_product_at basepoint (((Gromov_extension f)^^n) x) (attracting_fixed_point f)  ereal M"
proof -
  have I: "isometry f"
    using loxodromic_isometryD(1)[OF assms] by simp
  have J: "¦ereal r¦  " for r by auto

  text ‹We show that $f^n e$ tends to the repelling fixed point in negative time.›
  have "(λn. ereal (Busemann_function_at (repelling_fixed_point f) ((inv f ^^ n) basepoint) basepoint))  - "
  proof (rule tendsto_sandwich[of "λn. -" _ _ "λn. ereal(- real n * additive_strength f (repelling_fixed_point f) + 2 * deltaG(TYPE('a)))", OF _ always_eventually], auto)
    fix n
    have "Busemann_function_at (repelling_fixed_point f) ((inv f ^^ n) basepoint) basepoint  real n * additive_strength (inv f) (repelling_fixed_point f) + 2 * deltaG(TYPE('a))"
      using Busemann_function_eq_additive_strength[OF isometry_inverse(1)[OF I]
      Gromov_extension_inv_fixed_point[OF I loxodromic_repelling_fixed_point(2)[OF assms]], of n basepoint] by auto
    then show "Busemann_function_at (repelling_fixed_point f) ((inv f ^^ n) basepoint) basepoint  2 * deltaG(TYPE('a)) - real n * additive_strength f (repelling_fixed_point f)"
      by (simp add: I additive_strength_inv assms loxodromic_repelling_fixed_point(2))
  next
    have "(λn. ereal (2 * deltaG TYPE('a)) + ereal (- real n) * additive_strength f (repelling_fixed_point f))  ereal (2 * deltaG (TYPE('a))) + (- ) * additive_strength f (repelling_fixed_point f)"
      apply (intro tendsto_intros) using loxodromic_repelling_fixed_point(3)[OF assms] by auto
    then show "(λn. ereal (2 * deltaG TYPE('a) - real n * additive_strength f (repelling_fixed_point f)))  - "
      using loxodromic_repelling_fixed_point(3)[OF assms] by auto
  qed
  then have "(λn. to_Gromov_completion (((inv f)^^n) basepoint))  repelling_fixed_point f"
    by (rule Busemann_function_minus_infinity_imp_convergent[of _ _ basepoint])
  then have "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (((inv f)^^n) basepoint)) (repelling_fixed_point f))  "
    unfolding Gromov_completion_boundary_limit[OF loxodromic_repelling_fixed_point(1)[OF assms]] by simp
  then obtain Nr where Nr: "n. n  Nr  extended_Gromov_product_at basepoint (to_Gromov_completion (((inv f)^^n) basepoint)) (repelling_fixed_point f)  ereal (K + deltaG(TYPE('a)) + 1)"
    unfolding Lim_PInfty by auto

  text ‹We show that $f^n e$ tends to the attracting fixed point in positive time.›
  have "(λn. ereal (Busemann_function_at (attracting_fixed_point f) ((f ^^ n) basepoint) basepoint))  - "
  proof (rule tendsto_sandwich[of "λn. -" _ _ "λn. ereal(real n * additive_strength f (attracting_fixed_point f) + 2 * deltaG(TYPE('a)))", OF _ always_eventually], auto)
    fix n
    show "Busemann_function_at (attracting_fixed_point f) ((f ^^ n) basepoint) basepoint  real n * additive_strength f (attracting_fixed_point f) + 2 * deltaG(TYPE('a))"
      using Busemann_function_eq_additive_strength[OF I loxodromic_attracting_fixed_point(2)[OF assms], of n basepoint] by auto
  next
    have "(λn. ereal (2 * deltaG TYPE('a)) + ereal (real n) * additive_strength f (attracting_fixed_point f))  ereal (2 * deltaG (TYPE('a))) + () * additive_strength f (attracting_fixed_point f)"
      apply (intro tendsto_intros) using loxodromic_attracting_fixed_point(3)[OF assms] by auto
    then show "(λn. ereal (real n * additive_strength f (attracting_fixed_point f) + 2 * deltaG TYPE('a)))  - "
      using loxodromic_attracting_fixed_point(3)[OF assms] by (auto simp add: algebra_simps)
  qed
  then have *: "(λn. to_Gromov_completion (((f)^^n) basepoint))  attracting_fixed_point f"
    by (rule Busemann_function_minus_infinity_imp_convergent[of _ _ basepoint])
  then have "(λn. extended_Gromov_product_at basepoint (to_Gromov_completion (((f)^^n) basepoint)) (attracting_fixed_point f))  "
    unfolding Gromov_completion_boundary_limit[OF loxodromic_attracting_fixed_point(1)[OF assms]] by simp
  then obtain Na where Na: "n. n  Na  extended_Gromov_product_at basepoint (to_Gromov_completion (((f)^^n) basepoint)) (attracting_fixed_point f)  ereal (M + deltaG(TYPE('a)))"
    unfolding Lim_PInfty by auto

  text ‹We show that the distance between $e$ and $f^n e$ tends to infinity.›
  have "(λn. extended_Gromov_distance (to_Gromov_completion basepoint) (to_Gromov_completion ((f^^n) basepoint))) 
          extended_Gromov_distance (to_Gromov_completion basepoint) (attracting_fixed_point f)"
    using * extended_Gromov_distance_continuous[of "to_Gromov_completion basepoint"]
    by (metis UNIV_I continuous_on filterlim_compose tendsto_at_iff_tendsto_nhds)
  then have "(λn. extended_Gromov_distance (to_Gromov_completion basepoint) (to_Gromov_completion ((f^^n) basepoint)))  "
    using loxodromic_attracting_fixed_point(1)[OF assms] by simp
  then obtain Nd where Nd: "n. n  Nd  dist basepoint ((f^^n) basepoint)  M + K + 3 * deltaG(TYPE('a))"
    unfolding Lim_PInfty by auto

  text ‹Now, if $n$ is large enough so that all the convergences to infinity above are almost
  realized, we show that a point $x$ which is not too close to $\xi^-$ is sent by $f^n$ to a point
  close to $\xi^+$, uniformly.›
  define N where "N = Nr + Na + Nd"
  have "extended_Gromov_product_at basepoint (((Gromov_extension f)^^n) x) (attracting_fixed_point f)  ereal M" if H: "extended_Gromov_product_at basepoint x (repelling_fixed_point f)  K" "n  N" for n x
  proof -
    have n: "n  Nr" "n  Na" "n  Nd" using that unfolding N_def by auto
    have "min (extended_Gromov_product_at basepoint x (to_Gromov_completion (((inv f)^^n) basepoint)))
              (extended_Gromov_product_at basepoint (to_Gromov_completion (((inv f)^^n) basepoint)) (repelling_fixed_point f))
           extended_Gromov_product_at basepoint x (repelling_fixed_point f) + deltaG(TYPE('a))"
      by (intro mono_intros)
    also have "...  ereal K + deltaG(TYPE('a))"
      apply (intro mono_intros) using H by auto
    finally have "min (extended_Gromov_product_at basepoint x (to_Gromov_completion (((inv f)^^n) basepoint)))
              (extended_Gromov_product_at basepoint (to_Gromov_completion (((inv f)^^n) basepoint)) (repelling_fixed_point f))
                 ereal K + deltaG(TYPE('a))"
      by simp
    moreover have "extended_Gromov_product_at basepoint (to_Gromov_completion (((inv f)^^n) basepoint)) (repelling_fixed_point f) > ereal K + deltaG(TYPE('a))"
      using Nr[OF n(1)] ereal_le_less by auto
    ultimately have A: "extended_Gromov_product_at basepoint x (to_Gromov_completion (((inv f)^^n) basepoint))  ereal K + deltaG(TYPE('a))"
      using not_le by fastforce
    have *: "((inv f)^^n) ((f^^n) z) = z" for z
      by (metis I bij_is_inj inj_fn inv_f_f inv_fn isometry_inverse(2))
    have **: "x = Gromov_extension ((inv f)^^n) (Gromov_extension (f^^n) x)"
      using Gromov_extension_isometry_composition[OF isometry_iterates[OF I] isometry_iterates[OF isometry_inverse(1)[OF I]], of n n]
      unfolding comp_def * apply auto by meson
    have "extended_Gromov_product_at (((inv f)^^n) ((f^^n) basepoint)) (Gromov_extension ((inv f)^^n) (Gromov_extension (f^^n) x)) (Gromov_extension (((inv f)^^n)) (to_Gromov_completion basepoint))  ereal K + deltaG(TYPE('a))"
      using A by (simp add: * **[symmetric])
    then have B: "extended_Gromov_product_at ((f^^n) basepoint) (Gromov_extension (f^^n) x) (to_Gromov_completion basepoint)  ereal K + deltaG(TYPE('a))"
      unfolding Gromov_extension_preserves_extended_Gromov_product[OF isometry_iterates[OF isometry_inverse(1)[OF I]]] by simp

    have "dist basepoint ((f^^n) basepoint) - deltaG(TYPE('a)) 
        extended_Gromov_product_at ((f^^n) basepoint) (Gromov_extension (f^^n) x) (to_Gromov_completion basepoint) + extended_Gromov_product_at basepoint (Gromov_extension (f^^n) x) (to_Gromov_completion ((f^^n) basepoint))"
      using extended_Gromov_product_add_ge[of basepoint "(f^^n) basepoint" "Gromov_extension (f^^n) x"] by (auto simp add: algebra_simps)
    also have "...  (ereal K + deltaG(TYPE('a))) + extended_Gromov_product_at basepoint (Gromov_extension (f^^n) x) (to_Gromov_completion ((f^^n) basepoint))"
      by (intro mono_intros B)
    finally have "extended_Gromov_product_at basepoint (Gromov_extension (f^^n) x) (to_Gromov_completion ((f^^n) basepoint))  dist basepoint ((f^^n) basepoint) - (2 * deltaG(TYPE('a)) + K)"
      apply (simp only: ereal_minus_le [OF J] ereal_minus(1) [symmetric])
      apply (auto simp add: algebra_simps)
      apply (metis (no_types, hide_lams) add.assoc add.left_commute mult_2_right plus_ereal.simps(1))
      done
    moreover have "dist basepoint ((f ^^ n) basepoint) - (2 * deltaG TYPE('a) + K)  M + deltaG(TYPE('a))"
      using Nd[OF n(3)] by auto
    ultimately have "extended_Gromov_product_at basepoint (Gromov_extension (f^^n) x) (to_Gromov_completion ((f^^n) basepoint))  ereal (M + deltaG(TYPE('a)))"
      using order_trans ereal_le_le by auto
    then have "ereal (M + deltaG(TYPE('a)))  min (extended_Gromov_product_at basepoint (Gromov_extension (f^^n) x) (to_Gromov_completion ((f^^n) basepoint)))
                                                  (extended_Gromov_product_at basepoint (to_Gromov_completion ((f^^n) basepoint)) (attracting_fixed_point f))"
      using Na[OF n(2)] by (simp add: extended_Gromov_product_at_commute)
    also have "...  extended_Gromov_product_at basepoint (Gromov_extension (f^^n) x) (attracting_fixed_point f) + deltaG(TYPE('a))"
      by (intro mono_intros)
    finally have "ereal M  extended_Gromov_product_at basepoint (Gromov_extension (f^^n) x) (attracting_fixed_point f)"
      unfolding plus_ereal.simps(1)[symmetric] ereal_add_le_add_iff2 by auto
    then show ?thesis
      by (simp add: Gromov_extension_isometry_iterates I)
  qed
  then show ?thesis
    by auto
qed

text ‹We deduce pointwise convergence from the previous result.›

lemma loxodromic_attracting_fixed_point_attracts:
  assumes "loxodromic_isometry f"
          "xi  repelling_fixed_point f"
  shows "(λn. ((Gromov_extension f)^^n) xi)  attracting_fixed_point f"
proof -
  have "(λn. extended_Gromov_product_at basepoint (((Gromov_extension f)^^n) xi) (attracting_fixed_point f))  "
    unfolding Lim_PInfty using loxodromic_attracting_fixed_point_attracts_uniformly[OF assms(1)]
    by auto (metis Gromov_boundary_extended_product_PInf assms(2) dual_order.refl real_le_ereal_iff real_of_ereal_le_0 zero_ereal_def)
  then show ?thesis
    unfolding Gromov_completion_boundary_limit[OF loxodromic_attracting_fixed_point(1)[OF assms(1)]] by simp
qed

text ‹Finally, we show that a loxodromic isometry has exactly two fixed points, its attracting and
repelling fixed points defined above. Indeed, we already know that these points are fixed. It
remains to see that there is no other fixed point. But a fixed point which is not the repelling one
is both stationary and attracted to the attracting fixed point by the previous lemma, hence it has
to coincide with the attracting fixed point.›

theorem loxodromic_unique_fixed_points:
  assumes "loxodromic_isometry f"
  shows "Gromov_extension f xi = xi  xi = attracting_fixed_point f  xi = repelling_fixed_point f"
proof -
  have "xi = attracting_fixed_point f" if H: "Gromov_extension f xi = xi" "xi  repelling_fixed_point f" for xi
  proof -
    have "((Gromov_extension f)^^n) xi = xi" for n
      apply (induction n) using H(1) by auto
    then have "(λn. ((Gromov_extension f)^^n) xi)  xi"
      by auto
    then show ?thesis
      using loxodromic_attracting_fixed_point_attracts[OF assms H(2)] LIMSEQ_unique by auto
  qed
  then show ?thesis
    using loxodromic_attracting_fixed_point(2)[OF assms] loxodromic_repelling_fixed_point(2)[OF assms] by auto
qed

end (*of theory Isometries_Classification*)